Snasui Excel Forum

Code: Select all

Sub test1()
Dim r As Range
For Each r In Range("B1", Range("B" & Rows.Count).End(xlUp))
    If r.Offset(0, 11) = "" And r.Offset(0, 10) = "" And r.Offset(0, 9) = "" And r.Offset(0, 8) = "" And r.Offset(0, 7) = "" And r.Offset(0, 6) = "" Then        
        r.Offset(0, 2).Resize(1, 4).Copy r.Offset(0, 8)
        r.Offset(0, 2).Resize(1, 4).Clear
    End If
Next r
End Sub