|
Hallo! Ja, hab's grad gesehen, War mein Fehler. Der index inder letzten Schliefe hat nicht gepasst. Habe das geändert. Jetzt sollte er nicht nur die eine Zeile sondern auch die anderen kopieren. VG
Option Explicit
Sub einfügen()
'keine Prüfung, ob es so viele Blätter überhaupt gibt
Dim ende As Long
Dim i As Long
Dim j As Long
Dim zeile As Long
Dim ziel
Dim eintrag As Long
Dim test
Application.ScreenUpdating = False
Set ziel = Worksheets(1)
eintrag = 1 'ab da wird im Blatt 2 eingetragen
For i = 5 To 23 'Blätter 5 bis 23
zeile = 10 'ab da wird der Filter ausgelesen. in Zeile 9 war der Filtrer gesetzt
ende = 0
For j = 1 To 10
test = Worksheets(i).Cells(Rows.Count, j).End(xlUp).Row
If test > ende Then ende = test
Next
For j = zeile To ende
If Worksheets(i).Rows(j).Hidden <> True Then
Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 10)).Copy ziel.Cells(eintrag, 1)
ziel.Cells(eintrag, 11) = Worksheets(i).Name
eintrag = eintrag + 1
End If
Next j
eintrag = eintrag + 1
Next i
Application.ScreenUpdating = True
Set ziel
|