在vba中复制范围抛出运行时错误1004

我写了一个宏，它将源excel工作簿的前3列附加到汇总表中。在vba中复制范围抛出运行时错误1004

该代码从名为“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

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

在此先感谢。

来源

2017-07-14 Smriti Bhandari

更改您的代码喜欢这个

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

来源

2017-07-14 11:19:35

这是真的，但给PO一些解释为什么，为什么他应该有资格他所有的'Cells'和'Range'用'Worksheet'对象等 –

单元格（lastRow，“C”）不是WorkBk.Worksheets（“表格数据”）的单元格。它是activesheet的单元格。它发生错误。它应该转换为WorkBk.Worksheets（“表格数据”）。单元格（lastRow，“C”）。使用With语句简单地做到这一点。 –

在vba中复制范围抛出运行时错误1004

回答

相关问题