從多個文件打開復制數據到一個表 - 快捷方式

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