fände es toll wenn mir jemand helfen könnte. Rudolf
Public Sub newuser()
Dim rngSource As Range, rngTarget As Range
Dim iCounter As Integer
For i = [A65536].End(xlUp).Row To 1 Step -1
If Cells(i, 1).Font.ColorIndex = 41 Then Exit For
Next i
Worksheets("Dienstplan").Activate
Worksheets("Dienstplan").Rows("9:15").Select
'Range("A8:AK15").Select
Selection.Copy
Worksheets("Dienstplan").Visible = False
Range("A" & (i + 7)).Select
Rows(i + 6).RowHeight = 6
Rows(i + 7).RowHeight = 6
Rows(i + 8).RowHeight = 7
Rows(i + 9).RowHeight = 15
Rows(i + 10).RowHeight = 13
Rows(i + 11).RowHeight = 10
Rows(i + 12).RowHeight = 10
Rows(i + 13).RowHeight = 13
ActiveSheet.Paste
Modul2.comment_check ' neuen arbeiter grau machen mit feiertagen
'Selection.Rows.ShowDetail = True
'Selection.Rows.Ungroup
Worksheets("Dienstplan").Visible = True
Worksheets("Dienstplan").Activate
For i = [A65536].End(xlUp).Row To 1 Step -1
If Cells(i, 1).Font.ColorIndex = 41 Then Exit For
Next i
Range("A" & (i + 7)).Select
Rows(i + 6).RowHeight = 6
Rows(i + 7).RowHeight = 6
Rows(i + 8).RowHeight = 7
Rows(i + 9).RowHeight = 15
Rows(i + 10).RowHeight = 13
Rows(i + 11).RowHeight = 10
Rows(i + 12).RowHeight = 10
Rows(i + 13).RowHeight = 13
ActiveSheet.Selection.Paste
'Selection.Rows.ShowDetail = True
'Selection.Rows.Ungroup
Worksheets("Dienstplan").Visible = False
'Range(i).Select
End Sub