Hi DTTODGG

Try this, it is simpel but it works. Change worksheets name so it
fits for you.

Sub rrr()
Dim kolA As Double
Dim i As Double

kolA = Cells(Rows.Count, "A").End(xlUp).Row
For i = 8 To kolA
If Range("A" & i) < "" Then
Worksheets("Ark2").Range("A" & (i - 6) & ":C" & (i - 6)) = _
ActiveSheet.Range("A" & i & ":C" & i).Value
Worksheets("Ark2").Range("D" & (i - 6)) = _
ActiveSheet.Range("C2")
Worksheets("Ark2").Range("E" & (i - 6)) = _
ActiveSheet.Range("C3")
Worksheets("Ark2").Range("F" & (i - 6)) = _
ActiveSheet.Range("C4")
Else
MsgBox " No data!!!"
Exit Sub
End If
Next i




End Sub


Regards Yngve