复制超过5张数据后的运行时错误1004

我已经编写代码将数据从位于单独工作簿中的不同工作表复制到新的主工作表，除非工作簿的数量从5增加到5，否则一切都工作正常。文件夹我得到这个错误Run-time Error 1004，然后导入停止。这里是代码：复制超过5张数据后的运行时错误1004

Sub simpleXlsMerger() 
    Dim bookList As Workbook 
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 
    Application.ScreenUpdating = False 
    Set mergeObj = CreateObject("Scripting.FileSystemObject") 

    'change folder path of excel files here 
    Set dirObj = mergeObj.Getfolder("C:\Users\hnoorzai\Desktop\test\") 
    Set filesObj = dirObj.Files 

    For Each everyObj In filesObj 
     Set bookList = Workbooks.Open(everyObj) 

     'Change B3:H to the range your working on and also B in B65536 to any column required. 
     bookList.Worksheets(1).Range("B3:H350" & Range("B65536").End(xlUp).Row).Copy 
     ThisWorkbook.Worksheets(1).Activate 

     'Below only change "B" column name to your required column name 
     Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
     Application.CutCopyMode = False 
     bookList.Close 
    Next 
End Sub

感谢提前的帮助:)

来源

2016-07-23 Hazmat

它是不是发生在同一个工作簿？尝试调试将带有错误的工作簿移动到另一个文件夹，并查看它是否发生在que中的下一个文件夹中？ –

@ShaiRado我确实移动到另一个文件夹，并尝试了很多其他的技术，但我仍然得到相同的错误任何其他线索??? – Hazmat

我不知道这是否会有所帮助，但您应该尝试对所有范围进行排位。所以不管它只是说'Range ...'将它改为'bookList.Worksheets（1）.Range ...'或任何正确的工作表和书籍。 –

我相信这是一个合格的问题，暗淡和设置您的工作表和相应的范围。

Sub Button1_Click() 
    Dim bookList As Workbook, sh As Worksheet, rng As Range, rw As Long 
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 
    Dim wb As Workbook 
    Application.ScreenUpdating = False 
    Set mergeObj = CreateObject("Scripting.FileSystemObject") 

    'change folder path of excel files here 
    Set dirObj = mergeObj.Getfolder("C:\Users\Dave\Downloads\TextCSV\") 
    Set filesObj = dirObj.Files 
    Set wb = ThisWorkbook 

    For Each everyObj In filesObj 

     Set bookList = Workbooks.Open(everyObj) 
     Set sh = bookList.Sheets(1) 

     With sh 
      rw = .Cells(.Rows.Count, "B").End(xlUp).Row 
      Set rng = .Range("B3:H" & rw) 
     End With 

     'Change B3:H to the range your working on and also B in B65536 to any column required. 
     rng.Copy 

     With wb 
      .Sheets(1).Cells(.Sheets(1).Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial xlPasteValues 
      Application.CutCopyMode = False 
     End With 

     bookList.Close 

    Next 

End Sub

来源

2016-07-23 15:15:35 Davesexcel

谢谢戴夫:) – Hazmat

我会避免激活任何工作簿并将值作为数组传送。

Sub simpleXlsMerger() 
    Dim bookList As Workbook 
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 
    Dim rSource As Range, Target As Range 
    Application.ScreenUpdating = False 
    Set mergeObj = CreateObject("Scripting.FileSystemObject") 

    'change folder path of excel files here 
    Set dirObj = mergeObj.Getfolder("C:\Users\hnoorzai\Desktop\test\") 
    Set filesObj = dirObj.Files 

    For Each everyObj In filesObj 
     Set bookList = Workbooks.Open(everyObj) 
     . 
     Set rSource = bookList.Worksheets(1).Range("B3:H350" & Range("B65536").End(xlUp).Row) 

     Set Target = ThisWorkbook.Worksheets(1).Range("B" & Rows.Count).End(xlUp).Offset(1, 0) 

     Target.Resize(rSource.Rows.Count, rSource.Columns.Count).Value = rSource.Value 

     bookList.Close 
    Next 
End Sub

来源

2016-07-23 20:00:02

复制超过5张数据后的运行时错误1004

回答

相关问题