Gleichartige Blätter zusammenführen

Sub BlaetterZusammenfuehren()
    Dim ws As Worksheet, out As Worksheet, ziel As Long, first As Boolean
    Set out = Worksheets.Add
    out.Name = "Gesamt_" & Format(Now, "hhnnss")
    ziel = 1: first = True
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> out.Name And ws.UsedRange.Rows.Count > 0 Then
            If first Then
                ws.UsedRange.Copy out.Cells(ziel, 1)
                ziel = out.Cells(out.Rows.Count, 1).End(xlUp).Row + 1
                first = False
            Else
                ws.UsedRange.Offset(1).Resize(ws.UsedRange.Rows.Count - 1).Copy out.Cells(ziel, 1)
                ziel = out.Cells(out.Rows.Count, 1).End(xlUp).Row + 1
            End If
        End If
    Next ws
    out.Columns.AutoFit
End Sub