Question

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

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

如果我的源xls中有几百行数据（从名称“Log *”开始），代码可以正常工作

但是，每当“”Log * .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

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

1 个答案: