使用Excel-VBA將數據從許多工作簿復制到摘要工作簿。 運行時錯誤

Question

我的文件夾中有文件，我想從這些文件中復制數據並將其粘貼到另一個Master工作簿工作表中。

我一直收到運行時error '1004' ：很抱歉，我們找不到C：\\ Users \\ jjordan \\ Desktop \\ Test Dir \\ MASTER`，它可能已被移動，重命名或刪除。

該錯誤在以下代碼行上突出顯示： Workbooks.Open SumPath & SumName

我在網上看到了其他與此類似的問題，我嘗試進行各種更改。 但是仍然沒有成功。 請指教。

• 源文件的目錄： C:\\Users\\ jjordan \\Desktop\\Test Dir\\GA Test\\
• 主文件的目錄： C:\\Users\\ jjordan \\Desktop\\Test Dir\\MASTER\\
• 源文件名有所不同，但均以"*.xlsx."結尾"*.xlsx."
• 主文件名： " MASTER – Data List - 2016.xlsm " '宏文件
• 源工作表名稱= "Supplier_Comments"

• 主工作表名稱= "Sheet5"

   Option Explicit Sub GetDataFromMaster() Dim MyPath As String Dim SumPath As String Dim MyName As String Dim SumName As String Dim MyTemplate As String Dim SumTemplate As String Dim myWS As Worksheet Dim sumWS As Worksheet 'Define folders and filenames MyPath = "C:\\Users\\jjordan\\Desktop\\Test Dir\\GA Test\\" SumPath = "C:\\Users\\jjordan\\Desktop\\Test Dir\\MASTER\\" MyTemplate = "*.xlsx" 'Set the template. SumTemplate = "MASTER – Data List - 2016.xlsm" 'Open the template file and get the Worksheet to put the data into SumName = Dir(SumPath & SumTemplate) Workbooks.Open SumPath & SumName Set sumWS = ActiveWorkbook.Worksheets("Sheet5") 'Open each source file, copying the data from each into the template file MyName = Dir(MyPath & MyTemplate) 'Retrieve the first file Do While MyName <> "" 'Open the source file and get the worksheet with the data we want. Workbooks.Open MyPath & MyName Set myWS = ActiveWorkbook.Worksheets("Suppliers_Comment") 'Copy the data from the source and paste at the end of sheet 5 myWS.Range("A2:N100").Copy sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues 'Close the current sourcefile and get the next Workbooks(MyName).Close SaveChanges:=False 'close MyName = Dir 'Get next file Loop 'Now all sourcefiles are copied into the Template file. Close and save it Workbooks(SumName).Close SaveChanges:=True End Sub 

Answer 1

這是您想要完成的工作的模板。 注意，正斜杠可能會導致運行時錯誤b / c vba以惱人的方式處理它們。

 Sub DougsLoop()
     Dim wbk As Workbook
     Dim Filename As String
     Dim path As String
     Dim rCell As Range
     Dim rRng As Range
     Dim wsO As Worksheet
     Dim StartTime As Double
     Dim SecondsElapsed As Double
     Dim sheet As Worksheet

     Application.ScreenUpdating = False 'these three statements help performance by disabling the self titled in each, remeber to re-enable at end of code
     Application.DisplayAlerts = False
     Application.Calculation = xlCalculationManual

     StartTime = Timer 'Starts timer to see how long code takes to execute. I like having this in macors that loop through files

     path = "C:\Users\jjordan\Desktop\Test Dir\GA Test" & "\" 'pay attention to this line of code********
     Filename = Dir(path & "*.xl??")
     Set wsO = ThisWorkbook.Sheets("Sheet5")

     Do While Len(Filename) > 0 'this tells the code to stop when there are no more files in the destination folder
         DoEvents
         Set wbk = Workbooks.Open(path & Filename, True, True)
             For Each sheet In ActiveWorkbook.Worksheets
                Set rRng = sheet.Range("a2:n100")
                For Each rCell In rRng.Cells
                    wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value = rCell
                Next rCell
             Next
         wbk.Close False
         Filename = Dir
     Loop

     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
     Application.Calculation = xlCalculationAutomatic
     SecondsElapsed = Round(Timer - StartTime, 2)
     MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
 End Sub

根據您的需要對此進行更改，您會發現它非常完美:)

編輯：同樣在您的代碼中，您經常使用COPY＆PASTE。 盡量避免以后再這樣做。 嘗試做一些事情：

 ThisWorkbook.Sheets("Sheet1").Range("a1").Value = OtherWork.Sheets("Sheet1").Range("a1").Value

這樣效率更高，並且不會使代碼陷入困境。

這是一些偏移邏輯

 wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value =
 wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 1).Value = 
 wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 2).Value = 

注意到Offset（x，y）值？ 本質上，x向下，y正確。 這當然是參考原始位置。 因此，要讓值進入同一行但三列，則可以使用“ Offset（0,3）”等

麻煩您讓您更改代碼以執行此操作。 :)

我想實際上試圖拼湊起來是一場斗爭嗎？ 在此版本中，假定宏位於母版工作簿中（並且您是在母版中運行它的）。 如果您想更改，請繼續，但是就我而言。 在某個時候，您必須自己進行試驗。