Option Explicit
Sub Transfer()
Dim sht1 As Worksheet ' Sheet 1
Dim sht2 As Worksheet ' Sheet 2
Dim ColNum2 As Long ' Next open column on sheet 2
' Initalize variables
Set sht1 = Sheets("Sheet1")
Set sht2 = Sheets("Sheet2")
' Get column number
ColNum2 = sht2.Cells(9, 771).End(xlToLeft).Column + 1
If ColNum2 < 3 Then
ColNum2 = 3
End If
' Copy cells
sht1.Cells(7, "C").Copy sht2.Cells(9, ColNum2)
sht1.Cells(10, "C").Copy sht2.Cells(10, ColNum2)
sht1.Cells(11, "C").Copy sht2.Cells(11, ColNum2)
sht1.Cells(12, "C").Copy sht2.Cells(12, ColNum2)
sht1.Cells(15, "C").Copy sht2.Cells(13, ColNum2)
sht1.Cells(19, "C").Copy sht2.Cells(14, ColNum2)
sht1.Cells(21, "C").Copy sht2.Cells(15, ColNum2)
sht1.Cells(22, "C").Copy sht2.Cells(16, ColNum2)
sht1.Cells(24, "C").Copy sht2.Cells(17, ColNum2)
sht1.Cells(27, "C").Copy sht2.Cells(18, ColNum2)
sht1.Cells(28, "C").Copy sht2.Cells(19, ColNum2)
sht1.Cells(29, "C").Copy sht2.Cells(20, ColNum2)
sht1.Cells(42, "C").Copy sht2.Cells(23, ColNum2)
sht1.Cells(44, "C").Copy sht2.Cells(24, ColNum2)
sht1.Cells(45, "C").Copy sht2.Cells(25, ColNum2)
sht1.Cells(46, "C").Copy sht2.Cells(26, ColNum2)
sht1.Cells(48, "C").Copy sht2.Cells(27, ColNum2)
sht1.Cells(54, "C").Copy sht2.Cells(28, ColNum2)
sht1.Cells(56, "C").Copy sht2.Cells(29, ColNum2)
sht1.Cells(57, "C").Copy sht2.Cells(30, ColNum2)
sht1.Cells(60, "C").Copy sht2.Cells(31, ColNum2)
sht1.Cells(61, "C").Copy sht2.Cells(32, ColNum2)
sht1.Cells(63, "C").Copy sht2.Cells(33, ColNum2)
sht1.Cells(64, "C").Copy sht2.Cells(34, ColNum2)
sht1.Cells(66, "C").Copy sht2.Cells(35, ColNum2)
sht1.Cells(67, "C").Copy sht2.Cells(36, ColNum2)
sht1.Cells(70, "C").Copy sht2.Cells(37, ColNum2)
Bookmarks