Открыть копию данных из нескольких файлов в один ярлык на листе

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 

Кроме того, вы можете избавиться от этих «выбрать» -линий, которые выглядят следующим образом:

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

Answer 2

Используйте лист, чтобы отобразить все папки, которые вы хотите, и создать цикл для упрощения кода. Вы можете использовать целочисленную переменную и CountA в столбце папок для получения количества циклов, которые вам нужно использовать. Если вы не понимаете, я могу написать пример через час.

Edit:

пример что-то вроде этого.

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