Sub test()
Dim oWS As Worksheet, oWSNeu As Worksheet
Dim rngQ As Range
Dim nRow&
With ThisWorkbook
Set oWSNeu = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
For Each oWS In ThisWorkbook.Worksheets
If oWS.Name oWSNeu.Name Then
With oWS
nRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If nRow 1 Or (.Cells(1, 1).Value "" Or .Cells(1, 2).Value "") Then
nRow = nRow + 1
End If
rngQ.Copy .Cells(nRow, 1)
End With
End If
Next
End With
End Sub
Gruß TinoDie erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen