Объединение разных листов в один лист (только указанные строки)

Question

У меня есть несколько листов (например, 24!). Я хотел бы объединить его в один лист. Все листы имеют сходную структуру с заголовком.

Glitch: В конце каждого листа есть один или два ряда с итоговыми данными

Я хотел бы, чтобы пропустить эти строки и есть продолжает данные всех рабочих листов.

Вот фрагмент кода, который я использовал для его объединения. Но он сделал несколько листов в одном файле excel. Можно ли добавить код в этот фрагмент кода.

Заранее благодарен!

Sub GetSheets() 
 
Path = "C:\path" 
 
Filename = Dir(Path & "*.XLSX") 
 
    Do While Filename <> "" 
 
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 
 
     For Each Sheet In ActiveWorkbook.Sheets 
 
    Sheet.Copy After:=ThisWorkbook.Sheets(1) 
 
     
 
    Next Sheet 
 
    Workbooks(Filename).Close 
 
    Filename = Dir() 
 
    Loop 
 
End Sub

Answer 1

Что следующий код сделать:
- код будет копировать данные со всех листов всех .xlsx файлов в указанной папке, предполагающих все файлы имеют одинаковый структура
- данные копируются в имя листа Output активного файл
- Последняя строка каждого листа не копируется предполагая, что она содержит сводные данные
- Заголовок будет скопирован из первого скопированного листа
- код не будет добавлять листов к текущему файлу

Sub GetSheets() 
    Dim path As String, fileName As String 
    Dim lastRow As Long, rowCntr As Long, lastColumn As Long 
    Dim outputWS As Worksheet 

    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 

    'this is the sheet where all the data will be displyed   
    Set outputWS = ThisWorkbook.Sheets("Output") 
    rowCntr = 1 

    path = "C:\path" & "\" 
    fileName = Dir(path & "*.XLSX") 
    Do While fileName <> "" 
     Workbooks.Open fileName:=path & fileName, ReadOnly:=True 
     For Each ws In ActiveWorkbook.Sheets 
      If rowCntr = 1 Then 
       'get column count 
       lastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column 
       'copy header 
       Range(outputWS.Cells(1, 1), outputWS.Cells(1, lastColumn)).Value = Range(ws.Cells(1, 1), ws.Cells(1, lastColumn)).Value 
       rowCntr = rowCntr + 1 
      End If 
      'get last row with data of each sheet 
      lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row 
      'copy data from each sheet to Output sheet 
      Range(outputWS.Cells(rowCntr, 1), outputWS.Cells(rowCntr + lastRow - 3, lastColumn)).Value = Range(ws.Cells(2, 1), ws.Cells(lastRow - 1, lastColumn)).Value 
      rowCntr = rowCntr + lastRow - 2 
     Next ws 
     Workbooks(fileName).Close 
     fileName = Dir() 
    Loop 

    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
End Sub 

Answer 2

После того, как вы получили их все в вашу рабочую книгу вы могли бы сделать еще один шаг, чтобы положить их на тот же лист.

Не зная расположение данных его трудно, но если я предполагаю, что всегда есть что-то в А1, и все это в большом блоке, то вы можете Переберите листов и скопировать что-то вроде:

Dim i as integer 
For i = 1 to ActiveWorkbook.Sheets.Count  
    Sheets(i).Range("A1").CurrentRegion.Copy 
    'Paste it into the sheet here below what's already there 
Next i 

Answer 3

После кода могут быть полезны для объединения листов. Это попросит просмотреть файл для объединения. Тогда он будет сочетать в себе все листы в один лист с именем «Объединить»

Sub Combine() 
    Dim openfile As String 
    MsgBox "Pls select Input file", vbOKOnly 
    openfile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select File To Be Opened") 
    Workbooks.OpenText (openfile) 

Dim J As Integer 
On Error Resume Next 
Sheets(1).Select 
Worksheets.Add 
Sheets(1).Name = "Combined" 
Sheets(2).Activate 
Range("A1").EntireRow.Select 
Selection.Copy Destination:=Sheets(1).Range("A1") 
For J = 2 To Sheets.Count 
Sheets(J).Activate 
Range("A1").Select 
Selection.CurrentRegion.Select 
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select 
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) 
Next 

Sheets(1).Select 

End Sub