在vba中複製範圍拋出運行時錯誤1004

Question

我寫了一個宏，它將源excel工作簿的前3列附加到彙總表中。

該代碼從名爲「Log * .xls」開始的源代碼工作簿選項卡「表格數據」中複製前三列中的非空單元格，並將其附加到彙總表中的列中。所有數據都在彙總表水平附加。

現在代碼工作完全正常，如果在我的源XLS數100行數據

但是每當「」日誌*的.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