Excel VBA: объединить несколько листов в один

Question

Я использую следующий код для объединения нескольких листов. Проблема в том, что этот код работает с листами, которые имеют заголовок в первой строке, а мои листы не имеют. Можно выбрать только 3 столбца (A, F и G). Я имею в виду диапазон из рабочих листов? Листы имеют одинаковую структуру, только количество строк может быть разным. Любая идея? Спасибо!

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
    Sheets(J).Activate ' make the sheet active
    Range("A1").Select
    Selection.CurrentRegion.Select ' select all cells in this sheets
    ' select all lines except title
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
    ' copy cells selected in the new sheet on last line
    Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Answer 1

Вместо копирования только A, F + G вы можете удалить все столбцы, которые вам не нужны, из полученного листа.

Sub Combine()
Dim jCt As Integer
Dim ws As Worksheets
Dim myRange As Range
Dim lastRow As Long
lastRow = 1

'Delete Worksheet combine if it exists
If sheetExists("Combined") Then
    Application.DisplayAlerts = False
    Sheets("Combined").Delete
    Application.DisplayAlerts = True
    MsgBox "Worksheet ""Combined"" deleted!"
End If

Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

' work through sheets
For jCt = 2 To Sheets.Count ' from sheet 2 to last sheet

    Set myRange = Sheets(jCt).Range(Sheets(jCt).Cells(1, 1), Sheets(jCt).Range("A1").SpecialCells(xlCellTypeLastCell))
    Debug.Print Sheets(jCt).Name, myRange.Address

    'Put the SheetName on the Sheet "Cominbed"
    Sheets("Combined").Range("A1").Offset(lastRow, 0) = Sheets(jCt).Name
    With Sheets("Combined").Range("A1").Offset(lastRow, 0).Font
        .Bold = True
        .Size = 14
    End With

    'copy the sheets
    myRange.Copy Destination:=Sheets("Combined").Range("A1").Offset(lastRow + 2, 0)
    lastRow = lastRow + myRange.Rows.Count + 3

Next
End Sub


Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function