Консолидация нескольких листов в нескольких книгах в одну книгу с теми же листами, но данные на нескольких листах будут объединены.

Question

Я пробовал искать это через Интернет, но для своей цели я пока не смог оптимизировать код, необходимый , Это то, что я пытаюсь выполнить:

У меня есть файлы под названием Excel 1, Excel 2, Excel 3 и Master Excel. Все файлы имеют одинаковое количество рабочих листов, имя рабочего листа и одну и ту же структуру, когда дело доходит до заголовка и т. Д.

Я пытаюсь объединить значения Excel 1, Excel 2 и Excel 3 в главный файл.

Итак, если у вас есть лист с именем 1000, скопируйте в него диапазон из листа Excel 1 с именем 1000. Затем найдите лист 1000 в Excel 2 и скопируйте диапазон на пустую строку после последнего строка, используемая в Листе основных файлов 1000.

Диапазон всегда представляет собой строку после заголовка (это фиксируется на всех листах) до последней строки с данными определенного столбца.

Теперь в каждой книге есть несколько листов, и все рабочие листы будут иметь одинаковое имя.

Также путь к файлу будет постоянным, поэтому я не хочу выбирать.

Код, приведенный ниже, способен прокручивать рабочие листы, и я также могу определить диапазон скоростей копирования, но только с учетом того, что я не знаю, как сопоставить целевой лист с листом адресата, означающим данные листа 1000 в excel 1 файл, который будет вставлен в лист 1000 в основной файл.

Sub test() 

Dim MyFile As String, MyFiles As String, FilePath As String 
Dim erow As Long 
'~~> Put additional variable declaration 
Dim wbMaster As Workbook, wbTemp As Workbook 
Dim wsMaster As Worksheet, wsTemp As Worksheet 

FilePath = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\" 
MyFiles = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\*.xlsx" 
MyFile = Dir(MyFiles) 

With Application 
    .ScreenUpdating = False 
    .DisplayAlerts = False 
End With 

'~~> Set your declared variables 
Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook 
Set wsMaster = wbMaster.Sheets("Sheet1") 'replace Sheet1 to suit 

Do While Len(MyFile) > 0 
    'Debug.Print MyFile 
    If MyFile <> "master.xlsm" Then 
     '~~> Open the file and at the same time, set your variable 
     Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True) 
     Set wsTemp = wbTemp.Sheets(1) 'I used index, you said there is only 1 sheet 
     '~~> Now directly work on your object 
     With wsMaster 
      erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row 
      '~~> Copy from the file you opened 
      wsTemp.Range("A2:S20").Copy 'you said this is fixed as well 
      '~~> Paste on your master sheet 
      .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues 
     End With 
     '~~> Close the opened file 
     wbTemp.Close False 'set to false, because we opened it as read-only 
     Set wsTemp = Nothing 
     Set wbTemp = Nothing 
    End If 
    '~~> Load the new file 
    MyFile = Dir 
Loop 

With Application 
    .ScreenUpdating = True 
    .DisplayAlerts = True 
End With 

End Sub 

Answer 1

Попробуйте это (см мои комментариев в коде), но я сделал некоторые небольшие изменения в вашем Do While цикла

Sub test() 

Dim MyFile As String, MyFiles As String, FilePath As String 
Dim erow As Long 
'~~> Put additional variable declaration 
Dim wbMaster As Workbook, wbTemp As Workbook 
Dim wsMaster As Worksheet, wsTemp As Worksheet 
Dim i As Integer 

FilePath = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\" 
MyFiles = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\*.xlsx" 
MyFile = Dir(MyFiles) 

With Application 
    .ScreenUpdating = False 
    .DisplayAlerts = False 
End With 

'~~> Set your declared variables 
Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook 

Do While Len(MyFile) > 0 
    'Debug.Print MyFile 
    If MyFile <> "master.xlsm" Then 
     '~~> Open the file and at the same time, set your variable 
     Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True) 
     'Start the loop of sheets within the source workbook 
     For i = 1 To wbTemp.Sheets.Count 
      Set wsTemp = wbTemp.Sheets(i) 'I used index, you said there is only 1 sheet 
      '~~> Now directly work on your object 
      With wbMaster.Worksheets(wsTemp.Name) 'This matches the sheet name in the source workbook to the sheet name in the target workbook 
       erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row of target sheet 
       '~~> Copy from the file you opened 
       wsTemp.Range("A2:S20").Copy 'you said this is fixed as well 
       '~~> Paste on your master sheet 
       .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues 
       Application.CutCopyMode = False 
      End With 
     Next i 
     '~~> Close the opened file 
     wbTemp.Close False 'set to false, because we opened it as read-only 
    End If 
    '~~> Load the new file 
    MyFile = Dir 
Loop 

With Application 
    .ScreenUpdating = True 
    .DisplayAlerts = True 
End With 

End Sub 

Answer 2

принять sheetnames в wbMaster и ссылаться на лист с тем же именем в wbTemp, вы можете передать имя через переменную. Вот несколько строк, которые будут петли через ваши листы в wbMaster

Dim strSheetname as String 

For i = 1 To wbMaster.Sheets.Count 
     strSheetName = wbMaster.Sheets(i).Name 
     Set wsTemp = wbTemp.Sheets(strSheetName) 
     'Do whatever you need here with wsTemp 
Next i 

Этот код не хватает обработки ошибок (например, если лист существует в wbMaster, что не существует в wbTemp, вы получите ошибку выхода за диапазон) Но это поможет вам начать.