如何從Excel 2011中的幾個工作簿中編譯數據

Question

我正在嘗試使用VBA for Excel 2011 Mac從一個文件夾中的幾個工作簿復制一行數據並將其粘貼到主工作簿（在同一文件夾中）。 我有以下代碼，但始終遇到運行Runtime error 1004 。

調試后，它突出顯示了Workbooks.Open(MyFile)行，但我不知道為什么。 路徑正確。 任何人都可以請教出什么問題嗎？

我從適用於Windows的http://www.familycomputerclub.com/transfer-data-from-multiple-workbooks-into-master-workbook-automatically-using-vba.html獲得了原始代碼。 任何信息，將不勝感激！

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = ("/Users/administrator/Desktop/Excel")

Do While Len(MyFile) > 0
    If MyFile = "Test.xlsm" Then
    Exit Sub
    End If

    Workbooks.Open (MyFile)
    Range("A2:D2").Copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir

Loop

End Sub

Answer 1

您正在使用MyFile = ("/Users/administrator/Desktop/Excel") （為什么要加上括號？），但這實際上不是工作簿的有效路徑，對嗎？

我的意思是，當然，它應該指向.xlsm文件，而不只是指向目錄...這應該是導致錯誤的原因。

我認為您需要先在目錄中找到所有工作簿，然后再遍歷這些工作簿。 現在，您編寫代碼的方式在我看來確實是錯誤的，但這當然並不意味着它將無法正常工作。 但是我真的認為您需要首先為.xlsm文件解析目錄，然后循環遍歷這些文件。

更新

我認為這段代碼現在應該可以執行您想要的操作。

Sub LoopThroughFiles()

Dim directory As String
Dim file As Variant

directory = "C:\Users\RISE123\Desktop\NSRP\AFPR004\Foundations\20140702 - AFPR004 FA9 Change\"
file = Dir(directory)

Do While Len(file) > 0
    If InStr(1, file, ".xlsm", vbBinaryCompare) > 0 Then
        With Workbooks.Open(directory & file)
            Call .Worksheets(1).Range("A2:D2").Copy(ThisWorkbook.Sheets(1).Range("A2:D2"))
            Call .Close(False)
        End With
    End If
    file = Dir
Loop

End Sub

但是您將必須修改起始目錄路徑directory以及“ With End With塊中的邏輯以適合您的需求。