從多個工作簿傳輸數據

Question

目標-從多個工作簿中提取數據（總共5個）； 將數據粘貼到新的工作簿中。

問題/問題：
1）運行下面的VBA代碼后，它可以從所有5個工作簿中復制數據，但在粘貼時僅粘貼其中一個的數據。
2）剪貼板的彈出窗口已滿。 我已經編寫了清除剪貼板的代碼，但由於仍顯示彈出窗口，所以它似乎不起作用。

VBA代碼：

Sub LoopThroughDirectory()

Dim MyFile As String
Dim erow

Dim MyPath As String

MyPath = "Directory path"

MyFile = Dir(MyPath)

Do While Len(MyFile) > 0
If MyFile = "filename.xlsb" Then
End If

       Workbooks.Open (MyPath & MyFile)
       Range("A3:CP10000").Copy
       ActiveWorkbook.Close

'calculating the empty row

 erow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 

a = ActiveWorkbook.Name
b = ActiveSheet.Name

Worksheets("Raw Data").Paste Range("A2")

Application.CutCopyMode = False ' for clearing clipboard

MyFile = Dir

Loop

End Sub

我也在下面嘗試了另外兩個命令，但是它們似乎根本不返回任何數據。

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow + 1, 1), Cells(erow + 1, 30)) `pasting the data`
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A2")`pasting the data`

---

更新。
這是當前代碼：

Sub LoopThroughDirectory()

Dim MyFile As String
Dim erow As Long
Dim MyPath As String
Dim wb As Workbook

MyPath = "C:\Users\username\Downloads\PROJECTS\Project Name\Input file\"
MyFile = Dir(MyPath)

Do While Len(MyFile) > 0
    If InStr(MyFile, "post_level.xlsb") > 0 Then

        Set wb = Workbooks.Open(MyPath & MyFile)
        Range("A3:CP10000").Copy

        'calculating the empty row
         erow = ThisWorkbook.Worksheets("Raw Data").Cells(Rows.Count, "A").End(xlUp).Row

        ThisWorkbook.Worksheets("Raw Data").Paste (ThisWorkbook.Worksheets("Raw Data").Range("A" & erow + 2))

        Application.DisplayAlerts = False
        wb.Close False
        Application.DisplayAlerts = True
    End If
    MyFile = Dir
Loop

    ActiveWindow.Zoom = 90

End Sub

---

UPDATE2。

Sub LoopThroughDirectory()

Dim MyFile As String
Dim erow As Long
Dim MyPath As String
Dim wb As Workbook

MyPath = "C:\Users\username\Downloads\PROJECTS\ProjectNameFolder\SubFolder\MainFolder\Input file"
MyFile = Dir("C:\Users\username\Downloads\PROJECTS\ProjectNameFolder\SubFolder\MainFolder\Input file\*.*")

Do While Len(MyFile) > 0
    If InStr(MyFile, ".csv") > 0 Then

        Set wb = Workbooks.Open(MyPath & MyFile)
        Range("A3:CP10000").Copy

        'calculating the empty row
         erow = ThisWorkbook.Worksheets("Raw Data").Cells(Rows.Count, "A").End(xlUp).Row

        ThisWorkbook.Worksheets("Raw Data").Paste (ThisWorkbook.Worksheets("Raw Data").Range("A" & erow + 2))

        Application.DisplayAlerts = False
        wb.Close False
        Application.DisplayAlerts = True
    End If
    MyFile = Dir
Loop

End Sub

Answer 1

希望我能為您提供幫助...您的代碼中存在多個錯誤，並且不確定是否按照您想要的方式修復了它們。

僅提及一個主要錯誤將很有用。 您不能將以下兩行放在一起：

If MyFile = "filename.xlsb" Then
End If

在這些行之間 ， If滿足條件，則必須放置要執行的每個過程。 在原始情況下，如果有一個名為“ filename.xlsb”的文件，則不會發生任何事情，因為您立即關閉了代碼塊。

嘗試類似下面的代碼。 它對我來說是從目錄C:\\Temp\\中所有擴展名為.xlsb的文件中導入數據的

Sub LoopThroughDirectory()

Dim MyFile As String
Dim erow As Long
Dim MyPath As String
Dim wb As Workbook

MyPath = "C:\Temp\"
MyFile = Dir(MyPath)

Do While Len(MyFile) > 0
    If InStr(MyFile, ".xlsb") > 0 Then

        Set wb = Workbooks.Open(MyPath & MyFile)
        Range("A3:CP10000").Copy

        'calculating the empty row
         erow = ThisWorkbook.Worksheets("Raw Data").Cells(Rows.Count, "A").End(xlUp).Row

        ThisWorkbook.Worksheets("Raw Data").Paste (ThisWorkbook.Worksheets("Raw Data").Range("A" & erow + 2))

        Application.DisplayAlerts = False
        wb.Close False
        Application.DisplayAlerts = True
    End If
    MyFile = Dir
Loop

End Sub