try:

Sub Name_Hours_OPNumber()

Dim vardata As Variant
Dim i As Long, n As Long

Application.ScreenUpdating = False

With Sheets("Sheet1")
vardata = .Range("D7:D" & .Cells(Rows.Count, "D").End(xlUp).Row)
End With
n = 4

For i = LBound(vardata) To UBound(vardata)
With Sheets("Sheet3")
.Activate
.Cells(4, n) = vardata(i, 1)
.Range(Cells(4, n), Cells(4, n + 1)).Select
Selection.HorizontalAlignment = xlCenterAcrossSelection
End With
n = n + 2
Next
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--

Hi Claus,

Very nice! Works excellent. Thank you.

I added some lines to do additional stuff.

Do you see any glaring errors? It does exactly what I want it to do, but may not be best coding practices.

Howard

Sub Name_Hours_OPNumber()

Dim vardata As Variant
Dim i As Long, n As Long

Application.ScreenUpdating = False

With Sheets("Sheet3").Range("4:5")
.ClearContents
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
End With

With Sheets("Sheet1")
vardata = .Range("D7:D" & .Cells(Rows.Count, "D").End(xlUp).Row)
End With

n = 4

For i = LBound(vardata) To UBound(vardata)

With Sheets("Sheet3")
.Activate
.Cells(4, n) = vardata(i, 1)
.Cells(5, n) = "Hours"
.Cells(5, n + 1) = "OP Number"
.Range(Cells(4, n), Cells(4, n + 1)).Select
Selection.HorizontalAlignment = xlCenterAcrossSelection
End With

n = n + 2
Next

[D6].Activate
Application.ScreenUpdating = True

End Sub