Sub GesamtAnlagenkatastererzeugen()
Dim sBlattname As String, ws As Worksheet, loLetzte As Long
sBlattname = "Kataster" & Format(Now, "YYYYMMDD")
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = sBlattname Then
MsgBox "Es existiert bereits ein Datenblatt mit dem Namen Kataster." & vbLf & "Dieses bitte umbenennen oder löschen.", , "Meldung"
Exit Sub
Else
ThisWorkbook.Worksheets("Vor_Kataster").Copy before:=Sheets(1)
ActiveSheet.Name = sBlattname
Exit For
End If
Next ws
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "Ue_*" Then
With ws
loLetzte = .Cells(.Rows.Count, 15).End(xlUp).Row
.Rows("1:" & loLetzte).Copy
With Worksheets(sBlattname)
loLetzte = .Cells(.Rows.Count, 15).End(xlUp).Offset(1).Row
.Rows(loLetzte).PasteSpecial Paste:=xlPasteAll
End With
End With
End If
Next ws
Application.CutCopyMode = False
End Sub