複製超過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

回答

相關問題