从多个工作簿传输数据

目标 – 从多个工作簿中提取数据（共5个）; 将数据粘贴到新的工作簿中。

问题/问题：
1）运行下面的VBA代码后，它可以从所有5个工作簿中复制数据，但粘贴时仅粘贴其中一个数据。
2）剪贴板的popup窗口已满。 我已经写了一个代码来清除剪贴板，但它似乎不起作用，因为我仍然popup窗口。

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”的文件，则不会发生任何事情，因为您立即closures了代码块。

尝试类似于下面的代码。 它对我来说是从目录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