使用Excel-VBA将数据从许多工作簿复制到摘要工作簿。 运行时错误
我有一个文件夹中的文件，我想从这些文件复制数据，并将其粘贴到另一个主工作簿表。
我一直得到一个运行时error '1004' ：对不起，我们找不到C：\ Users \ jjordan \ Desktop \ Test Dir \ MASTER`，它可能被移动，重命名或删除。
错误在这行代码中突出显示： Workbooks.Open SumPath & SumName
我在网上看到过类似的其他问题，我尝试过不同的修改。 但仍然没有成功。 请指教。
- 目录文件的目录：
C:\Users\ jjordan \Desktop\Test Dir\GA Test\ - Dir for Master文件：
C:\Users\ jjordan \Desktop\Test Dir\MASTER\ - 源文件名不同，但都以
"*.xlsx."结尾"*.xlsx." - 主文件名：
" MASTER – Data List - 2016.xlsm "macros文件 - 源工作表名称=
"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
这是你想做什么的模板。 注意正斜杠可能会导致运行时错误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是正确的。 这当然是参考原来的位置。 所以要得到一个值在同一行，但三列你会使用“偏移（0,3）”等等
我让你改变你的代码来做到这一点。 🙂
我想实际上试图把它拼在一起是一场斗争？ 在这里，这个版本假定macros在主工作簿中（并且从主窗口运行它）。 如果你想改变，但这是我走的。 在某个时候，你必须自己做实验。