Hallo Forum,
ich möchte mit folgendes Makro alle Werte aus 4 sheets in ein neues Sheet untereinander kopieren. Dies funktioniert, leider wir beim Kopiervorgang immer der letzte Werte aus allen Sheets im Sheet "Sammlung" überschrieben, so dass 4 Werrte im Sheet Sammlung fehlen.
Wo liegt der Fehler?
Dim i As Integer
Dim LngRow, lngLC As Long, zeile As Long
Sheets.Add(After:=Sheets(4)).Name = "Sammlung"
For i = 1 To 4 'Schleife über 4 Sheets
With Sheets(i)
LngRow = .Range("E:E").Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Row + 1
zeile = Sheets("Sammlung").Cells(Rows.Count, 1).End(xlUp).Row + 1 '*letzte Reihe von unten +1
lngLC = .Cells(3, Columns.Count).End(xlToLeft).Column 'Letzte Spalte ab Spalte A
.Range("E3:E" & LngRow).Resize(, lngLC - 3).Copy
Sheets("Sammlung").Cells(zeile, "A").End(xlUp).PasteSpecial xlPasteValues 'Nur Werte kopieren
next
end with