VBA to copy various cells in sheet 2 and find next blank WHOLE row and paste

Hello,
I have a workbook with the following VBA. It mainly works but when it pastes to the relevant column it doesn't pick last whole row just the last blank cell in that column.
sheet two is a basic sheet with data on it. I want it to enter particular cells in next blank row but all data in same row. Need Help

Sub CopyPaste()
Sheets(2).Range("B1").Copy
Sheets(1).Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("J1").Copy
Sheets(1).Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("A5").Copy
Sheets(1).Cells(Cells.Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("A6").Copy
Sheets(1).Cells(Cells.Rows.Count, 4).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("A7").Copy
Sheets(1).Cells(Cells.Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("A8").Copy
Sheets(1).Cells(Cells.Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("A9").Copy
Sheets(1).Cells(Cells.Rows.Count, 7).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("A10").Copy
Sheets(1).Cells(Cells.Rows.Count, 8).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("B11").Copy
Sheets(1).Cells(Cells.Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ActiveSheet.PrintOut
Sheets(2).Range("B1").ClearContents
Sheets(2).Range("A5:A10").ClearContents
Sheets(2).Range("B11").ClearContents
Sheets("Register").Select
ThisWorkbook.Save
End Sub

The second set of formula seems to work but it always picks row 16 not the first available blank row?

SWEET works like a charm thanks so much, has saved me a big headache