vba 中的复制范围引发运行时错误 1004

Question

我编写了一个宏，将源 Excel 工作簿中的前 3 列附加到摘要表中。

代码从源工作簿的“表格数据”选项卡中复制前 3 列中的非空单元格，以名称“Log*.xls”开头，并将其附加到摘要表中的列。摘要中的所有数据表格是水平附加的。

如果我的源 xls 中有 100 行数据（以名称“Log*”开头），现在代码可以正常工作

但是，每当“L​​og*.xsl”文件跨越数千个时，我在从源文件处理数据时就会收到运行时错误。

行错误：

WorkBk.Worksheets("Tabular Data").Range("A1", Cells(lastRow, "C")).Copy

宏如下：

Sub MergeAllWorkbooks()

Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Integer
Dim NextCol As Long
Dim lastRow As Long
Dim FileName As String
Dim WorkBk As Workbook


' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

' Modify this folder path to point to the files you want to use.
FolderPath = ThisWorkbook.Path


' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "\" & "Log*.xls")
NRow = 1

' Loop until Dir returns an empty string.
Do While FileName <> ""



    ' Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & "\" & FileName)


    ' Find the last non-empty cell in the last row of col C from each Source sheet
    ' Set the source range to be A:1 through C:lastrow

     'lastRow = WorkBk.Worksheets("Tabular Data").Range("C" & Rows.Count).End(xlUp).Row
     'Set SourceRange = WorkBk.Worksheets("Tabular Data").Range("A1:C" & lastRow).Copy

     lastRow = WorkBk.Worksheets("Tabular Data").Range("A65536").End(xlUp).Row
     WorkBk.Worksheets("Tabular Data").Range("A1", Cells(lastRow, "C")).Copy


     If NRow = 1 Then
        SummarySheet.Range("A65536").End(xlUp).PasteSpecial
        NRow = NRow + 1

     Else
        NextCol = SummarySheet.Cells(1, Columns.Count).End(xlToLeft).Column
        SummarySheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
        'SummarySheet.Range("A65536").End(xlUp).Offset(0, 1).PasteSpecial

     End If

    ' Close the source workbook without saving changes.
    Application.CutCopyMode = False
    WorkBk.Close savechanges:=False

    ' Use Dir to get the next file name.
    FileName = Dir()


Loop

' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet.Columns.AutoFit
SummarySheet.SaveAs (FolderPath & "\" & "Consolidated_Temp_Data.xls")
MsgBox (NRow & " Files Read ")

End Sub

请任何人帮助我解决我的问题的原因和解决方案？

提前致谢。

Answer 1

你的代码变成了这样

With WorkBk.Worksheets("Tabular Data")
    .Range("A1", .Cells(lastRow, "C")).Copy
End If