从多个文件打开复制数据到一个表 - 快捷方式

Question

希望你能帮助我只知道基础知识，并试图看到有一种简单的方法来重复vba中的过程而不是重新输入。

基本上我需要将多个文件中的数据复制到一个文件中。我想要复制的文件全部位于不同的子文件夹中。

这里是我有什么，但你可以看到，我只是复制代码，更改文件位置完成其工作任务，但只是想知道，因为有多个文件，这是在不同的位置，如果更简单的方法。

Sub Disconnections() 

' 
' Disconnections Macro 
' 
SheetName = Format(Date, "dd-mm-yyyy") 
On Error GoTo AddNew 
Sheets(SheetName).Activate 
Exit Sub 
AddNew: 
Sheets.Add , Worksheets(Worksheets.Count) 
ActiveSheet.Name = SheetName ' 
    Workbooks.Open Filename:= _ 
     "C:\My Documents\Customer 1\Customer 1 Data List" 
    Sheets("Disconnections").Select 
    Sheets("Disconnections").AutoFilterMode = False 
    Range("A1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.Copy 
    Windows("Disconnections.xlsm").Activate 
    ActiveSheet.Paste 
    Range("A1048576").End(xlUp).Offset(1, 0).Select 
Selection.End(xlDown).Select 
Range("A1048576").End(xlUp).Offset(1, 0).Select 
Windows("Connection List - Abel & Cole.xls").Activate 
ActiveWindow.Close 
Application.DisplayAlerts = False 
    Workbooks.Open Filename:= _ 
    "C:\My Documents\Customer 2\Customer 2 Data List" 
Sheets("Disconnections").Select 
Sheets("Disconnections").AutoFilterMode = False 
Range("A1").Select 
Range(Selection, Selection.End(xlDown)).Select 
Range(Selection, Selection.End(xlToRight)).Select 
Selection.Copy 
Windows("Disconnections.xlsm").Activate 
ActiveSheet.Paste 
Range("A1048576").End(xlUp).Offset(1, 0).Select 
Selection.End(xlDown).Select 
Range("A1048576").End(xlUp).Offset(1, 0).Select 
Windows("Connection List.xls").Activate 
ActiveWindow.Close 
Application.DisplayAlerts = False 

End Sub 

这是可能的。

谢谢

***更新****

现在我就在运行时错误438 - 对象不支持此属性或方法。我想我错过了一些东西或编辑了错误的数据。可否请您让我知道

Sub Disconnections() 

' 
' Disconnections Macro 
' 
SheetName = Format(Date, "dd-mm-yyyy") 
On Error GoTo AddNew 
Sheets(SheetName).Activate 
Exit Sub 

AddNew: 
Sheets.Add , Worksheets(Worksheets.Count) 
ActiveSheet.Name = SheetName ' 

Dim x As Integer 
Dim numFolders As Integer 
numFolders =  WorksheetFunction.CountA(ThisWorkbook.Sheets("Sheet2").Column(1)) 

For x = 1 To numFolders 
Dim i As Integer, NoCustomers 
NoCustomers = 3 
For i = 1 To NoCustomers 
    Workbooks.Open Filename:= _ 
     "C:\My Documents\Customer 1 \ Customer 1 Data List 
    Sheets("Disconnections").Select 
    Sheets("Disconnections").AutoFilterMode = False 
    Range("A1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.Copy 
    Windows("Disconnections.xlsm").Activate 
    ActiveSheet.Paste 
    Selection.End(xlDown).Select 
    Windows("Customer 1 Data List.xls").Activate 
    ActiveWindow.Close 
    Application.DisplayAlerts = False 

Next i 
Next x 

End Sub 

Answer 1

只需使用一个像这样的循环出了什么问题：

Dim i As Integer, NoCustomers 

NoCustomers=99 
For i = 1 To NoCustomers 
    Workbooks.Open Filename:= "C:\My Documents\Customer "&i&"\Customer "&i&" Data List" 
    'do copy-paste-thing 
Next i 

此外，您可以摆脱那些“选择” -lines看起来像这样：

Range("A1048576").End(xlUp).Offset(1, 0).Select 

Answer 2

使用工作表列出所需的所有文件夹并创建一个用于简化代码的循环。您可以在文件夹列中使用整数变量和CountA来获取您需要使用的循环数。如果你不明白我可以在一个小时内写一个例子。

编辑：

的例子是这样的。

Dim x As Integer 
Dim numFolders As Integer 

numFolders = WorksheetFunction.CountA(ThisWorkbook.Sheets("sheetWithFoldersList").Column(1)) 

For x = 1 to numFolders 
'enter the code for looping' 
Next x