|
Habe nichts verändert - aus dem Forum herauskopiert und eingefügt - Ja.
Public Sub Daten_sammeln ()
Dim ws As Worksheet
Dim loLetzteQ As Long
Dim loLetzteZ As Long
Dim raKopierbereich As Range
Worksheets.Add Before:=Worksheets(1)
ActiveSheet.name = "Auswertung"
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Sparkasse", "BarEinnahmen", "BarAusgaben"
With ws
loLetzteQ = .Cells(.Rows.Count, 1).End(xlUp).Row
loLetzteZ = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
Set raKopierbereich = .Range(.Cells(7, 1), .Cells(loLetzteQ, 13))
raKopierbereich.Copy Worksheets(1).Cells(loLetzteZ, 1)
End With
Case Else
End Select
Next
Set raKopierbereich = Nothing
End Sub
|