Sub Schrittfelder()
Rows("7:7").Copy
With GetNextEmptyRow(Rows("11:11"))
.Insert Shift:=xlDown
With .Offset(RowOffset:=-1).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Delete
End With
Rows("7:7").ClearContents
End Sub
Function GetNextEmptyRow(rngRow As Range) As Range
Dim lngChkRow As Long, rngEmpty As Range
Dim bEmptyRow As Boolean
With rngRow.Worksheet
For lngChkRow = rngRow.Row To .UsedRange.Row + .UsedRange.Rows.CountLarge - 1
bEmptyRow = True
For Each rngEmpty In Intersect(.Rows(lngChkRow), .UsedRange).Cells
If Not IsEmpty(rngEmpty) Then
bEmptyRow = False
Exit For
End If
Next
If bEmptyRow Then
Set GetNextEmptyRow = .Rows(lngChkRow)
Exit For
End If
Next
End With
If Not bEmptyRow Then
Set GetNextEmptyRow = rngRow.Worksheet.Rows(lngChkRow)
End If
End Function