从一个工作表粘贴到另一个不工作

我有一个工作簿(两张表之间)内部的macros。 但现在我想在两个工作簿之间做到这一点。 我认为这个逻辑看起来很好,但是我错过了什么?

它运行所有的代码,我没有得到任何错误,但在同一时间它什么都不做。

Sub CTClearINCIDENTS() Dim ws1 As Workbook Dim ws1sheet As Worksheet Dim ws2 As Workbook Dim ws2sheet As Worksheet Dim lastRow As Long Set ws1 = ThisWorkbook Set ws1sheet = ws1.Sheets("INCIDENTS") ws1sheet.Rows(5 & ":" & ws1sheet.Rows.Count).ClearContents Dim FilePath As String File_Path = "C:\TEMP\TestExcel\Cambridge Daily Tracker " & Format(Now, "dd-MM-yyyy") & ".xlsx" Set ws2 = Workbooks.Open(File_Path) Set ws2sheet = ws2.Sheets("Page 1") With ws2sheet .AutoFilterMode = False lastRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A2" & lastRow).Copy ws1sheet.Range("A5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End With End Sub 

编辑1:轻微的xlPasteFormats> xlPasteValues的事情我忘了

  1. 如果您只需要复制数据(即不使用单元格格式),那么最有效的方法是将工作表的范围值读入Variant ,然后将该Variant写入新工作表的范围。

  2. 在定义范围时,需要注意失去对表单对象的控制权,以及select比您需要的选项更大的选项,或者依赖范围定义来吸引您。 在你的代码中有一些这样的例子。 在这一行中: lastRow = .Range("A" & Rows.Count).End(xlUp).Row你在ws2sheet中定义了Range,但是对活动工作表中的行进行了计数(无论是哪种情况, ,最有可能是相同的)。 在这一行中: ws1sheet.Rows(5 & ":" & ws1sheet.Rows.Count).ClearContents您可以定义第4行下方的整个工作表来清除(即使不使用它们,也可以使用所有百万行)。 当然,使用ClearContents Excel会比使用范围之外的单元处理更智能,但有一天您可能会被抓到。

  3. 如果您使用的是string,则坚持使用Excel自身使用的相同地址约定是最容易的。 一旦你开始偏离那些惯例,那么你会得到一些意想不到的结果。 只要在你的代码的这些行上添加一个Select就可以了,你会感到惊讶:

     lastRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("2:2" & lastRow).Select 

比方说,你最后一行是23,你的代码实际上是select“2:223”。

作为个人偏好,我喜欢把最后一行看作一个Range而不是Long因为那样我就可以完全避免这种types的错误了,就像这样:

  set rng = .Range("A1", lastRow) 

如果您需要跨越第一列以外的范围,则可以按列顺序调整它的大小。 这与你的情况有关,因为当你的数据可能只有几列时,你正在处理整行。 同样,Excel可能会处理大部分仍在工作表使用范围内的情况,但是为什么不自己控制范围呢?

我已经给出了两个可能的编码解决scheme的例子。 在这两种情况下,我已经假设了最后一列“E”,但是你会改变它以适合你的项目。 版本1是Variant和lastCell作为Range选项,版本2是Paste和LastCell作为Long选项:

 Dim fileName As String Dim sourceBook As Workbook Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim sourceData As Variant Dim rng As Range Dim lastCell As Range 'Prepare the target sheet Set targetSheet = ThisWorkbook.Sheets("INCIDENTS") Set rng = targetSheet.Range("A5", _ targetSheet.UsedRange.Cells(sourceSheet.UsedRange.Cells.Count)) rng.ClearContents 'Open source workbook and find data range fileName = "C:\TEMP\TestExcel\Cambridge Daily Tracker " & Format(Now, "dd-MM-yyyy") & ".xls" Set sourceBook = Workbooks.Open(File_Path) Set sourceSheet = sourceBook.Sheets("Page 1") Set lastCell = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp) 'Resize by desired columns (I've used '5', ie up to "E" column) sourceData = sourceSheet.Range("A2", lastCell).Resize(, 5).Value2 'Copy the data targetSheet.Range("A5").Resize(UBound(sourceData, 1), UBound(sourceData, 2)) = sourceData 

版本2,如果你觉得不得不使用粘贴:

 Dim fileName As String Dim sourceBook As Workbook Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim rng As Range Dim lastRow As Long 'Clear below row 4 of sheets Set targetSheet = ThisWorkbook.Sheets("INCIDENTS") Set rng = targetSheet.Range("A5", _ targetSheet.UsedRange.Cells(sourceSheet.UsedRange.Cells.Count)) rng.ClearContents 'Open source workbook and remove auto filter fileName = "C:\TEMP\TestExcel\Cambridge Daily Tracker " & Format(Now, "dd-MM-yyyy") & ".xls" Set sourceBook = Workbooks.Open(File_Path) Set sourceSheet = sourceBook.Sheets("Page 1") sourceSheet.AutoFilterMode = False 'Copy the data lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row Set rng = sourceSheet.Range("A2", sourceSheet.Cells(lastRow, "E")) ' whatever the last column is (I'ved used "E" as example) rng.Copy targetSheet.Range("A5").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False 

Per @ Ambie的build议我改变了范围。 起初( A2:A )只是复制A列。 但我发现( 2:2 )会复制行。

现在正在工作:

 Sub CTClearINCIDENTS() Dim ws1 As Workbook Dim ws1sheet As Worksheet Dim ws2 As Workbook Dim ws2sheet As Worksheet Dim lastRow As Long Set ws1 = ThisWorkbook Set ws1sheet = ws1.Sheets("INCIDENTS") ws1sheet.Rows(5 & ":" & ws1sheet.Rows.Count).ClearContents Dim FilePath As String File_Path = "C:\TEMP\TestExcel\Cambridge Daily Tracker " & Format(Now, "dd-MM-yyyy") & ".xls" Set ws2 = Workbooks.Open(File_Path) Set ws2sheet = ws2.Sheets("Page 1") With ws2sheet .AutoFilterMode = False lastRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("2:2" & lastRow).Copy ws1sheet.Range("A5").PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End With End Sub