Question

我在文件夹中有文件，我想从这些文件中复制数据并将其粘贴到另一个主工作簿表中。

我不断获得运行时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."
主文件名：" 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＆amp;粘贴了很多。尽量避免将来这样做。尝试做点什么：

 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 =

注意偏移（x，y）值？基本上x是向下，y是对的。这当然是参考原始立场。所以要获得一个值在同一行，但三列以上你将使用“偏移（0,3）”等等

我允许您更改代码以执行此操作。：）

我想实际上想把它拼凑起来是一场斗争？这个版本假设宏在主工作簿中（并且您从主服务器中运行它）。如果你想改变继续，但这就是我走的路。在某些时候，你必须自己试验。

使用Excel-VBA将许多工作簿中的数据复制到摘要工作簿。运行时错误

1 个答案: