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