ub GesamtAnlagenkatastererzeugen()
Dim j As Integer
Dim i As Integer
Dim sBlattname As String
Dim iClick As Integer
Dim Z As Long
sBlattname = "Kataster" & Format(Now, "YYYYMMDD")
If Not ActiveWorkbook.WorkSheetExists(sBlattname) Then
ActiveWorkbook.Sheets("Vor_Kataster").Copy before:=Sheets(1)
ActiveWorkbook.Sheets(1).Name = sBlattname
Else
iClick = MsgBox("Es existiert bereits ein Datenblatt mit dem Namen Kataster." & vbCrLf & "Dies bitte umbennen oder löschen.", , "Meldung")
If iClick = 1 Then GoTo Ende
End If
For i = 2 To ActiveWorkbook.Worksheets.Count - 1
j = InStr(1, Left(Worksheets(i).Name, 3), "Ue_")
If j > 0 Then
Z = Worksheets(i).UsedRange.Rows.Count
Worksheets(i).Range(Cells(1, 15), Cells(Z, 15)).EntireRow.Copy
Sheets(sBlattname).Range("O65536").End(xlUp).Select
ActiveCell.Offset(1, 0).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
Else
End If
Next i
Ende:
End Sub