Hallo noch mal.

Ich bin leider immer noch nicht am Ziel angekommen. 

Ich habe den Code jetzt einaml vereinfacht und versucht die bereits angesprochenen Punkte zu ändern. Für das Kopieren der Zeilen aus dem Quellblatt in das Zielblatt finde ich leider nur die Lösung mit der Variablen n. Gerne nehem ich auch Tips an, wie ich das besser lösen kann.

Die Sprungmarken habe ich (vorerst) entfernt.

Darüber habe ich noch eingebaut, dass jedes mal ein neues Blatt erzeugt wird.

Ich habe weiterhin das Probelm, das in den Monaten 1-11 die entsprechenden Zeilen in das neue Blatt kopiert werden sobal ich das ganze für Dezember starte, also der Wert der Variable monat auf 12 steht, kopiert er nicht nur alle Zeilen mit dem Datum (Dezember) sonder auch alle folgenden Leerzeilen in das neue Blatt. Ich verstehe es einfach nicht und kann den Fehler nicht finden.

Vielen Dank für die Hilfe

Martin

Ich erlaube mir noch einmal den neuen Code anzufügen:

Sub monatrapport_neut_temp2()

Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
Dim kopf As Long
Dim monat As Integer
Dim blatt As Object
Dim BlattName As String
Dim bolFlg As Boolean

monat = InputBox("Bitte gewünschten Monat eingeben")

With Worksheets("Dienst")
ZeileMax = .UsedRange.Rows.Count
End With

'** Neues benanntes Tabellenblatt einfügen
'** Blattname festlegen

BlattName = MonthName(monat)

'** Prüfen, ob das Blatt, welches eingefügt werden soll bereits vorhanden ist
'** Nur einfügen, wenn Blatt noch nicht vorhanden ist
For Each blatt In Sheets
 If blatt.Name = BlattName Then bolFlg = True
Next blatt

'** Blatt nur einfügen, wenn noch nicht vorhanden

If bolFlg = False Then
  With ThisWorkbook
    .Sheets.Add after:=Sheets(Worksheets.Count)
    .ActiveSheet.Name = (BlattName)
    
  End With
End If

'** Blatt formatieren

With Worksheets(BlattName)

Worksheets(BlattName).UsedRange.ClearContents

.Columns("a:z").NumberFormat = "[h]:mm"
.Range("a1:z5000").Interior.Color = vbWhite
.Range("a1:z5000").Borders.LineStyle = -4142
.Range("A1:z5000").Font.Name = "Calibri"
.Range("a1:z5000").Font.Bold = False
.Range("a1:z5000").Font.Size = 10

kopf = 9
n = 10
zeilex = 0

'ZeileMax = .UsedRange.Rows.Count

.Range("a" & kopf - 3).Value = "Name"
.Range("b" & kopf - 3).Value = Worksheets("Dienst").Range("b3").Value
.Range("a" & kopf - 2).Value = "Monat"
.Range("b" & kopf - 2) = MonthName(monat)
.Range("d" & kopf - 2).Value = "Jahr"
.Range("e" & kopf - 2).Value = "2021"
.Range("e" & kopf - 2).NumberFormat = "0000"
End With


With Worksheets(BlattName).Range("A" & kopf, "a" & kopf)

 .Value = "Dienst"
 .Font.Size = 13
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
With Worksheets(BlattName).Range("d" & kopf, "d" & kopf)
 .Value = "Beginn"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
With Worksheets(BlattName).Range("e" & kopf, "e" & kopf)
 .Value = "Ende"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
With Worksheets(BlattName).Range("f" & kopf, "f" & kopf)
 .Value = "Pause"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
With Worksheets(BlattName).Range("g" & kopf, "g" & kopf)
 .Value = "Stunden"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
 With Worksheets(BlattName).Range("h" & kopf, "h" & kopf)
 .Value = "Nacht"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
 End With
  With Worksheets(BlattName).Range("i" & kopf, "i" & kopf)
 .Value = "Sonntag"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
 End With

'** Daten des entsprechenden Monats in das neue Blatt kopieren

With Worksheets("Dienst")

For Zeile = 8 To ZeileMax

If Month(.Cells(Zeile, 1).Value) = monat Then

.Range("a" & Zeile, "i" & Zeile).Copy Destination:=Worksheets(BlattName).Rows(n)

n = n + 1

End If

Next Zeile
End With

End Sub