Try this


Sub Test3()

ColCount = Range("G1").Columns
Do While Cells(1, ColCount) <= Range("D2")
If Cells(1, ColCount) = Range("D1") Then
Range("G3:G5").Copy
Cells(2, ColCount).PasteSpecial _
Paste:=xlPasteAll, _
Transpose:=True
End If
ColCount = ColCount + 1
Loop
End Sub

"AirgasRob" wrote:

This code does what I want it to but it looks very messy to me. Is their a
more efficient way of doing this?

Sub Test3()
Range("G3:G5").Select
Selection.Copy
Range("G1").Select
Do While ((ActiveCell) < Range("D1"))
ActiveCell.Offset(0, 1).Select
If ((ActiveCell) = Range("D2")) Then
Exit Do
End If
Loop
ActiveCell.Offset(2, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 0).Select
Do While ((ActiveCell) = Range("D1"))
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(2, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 0).Select

If ((ActiveCell) = Range("D2")) Then
Exit Do
End If
Loop