Copying date to next cell in new sheet

Question

Struggle with this code below.

What I am trying to achieve is I have a purchase order form which when one is generated I would like to be able to copy certain cells to a purchase order log on a different sheet.

Currently I have this code

Sub Range_PasteSpecial_Values1()

    Worksheets("Sheet1").Range("A1").Copy
    Worksheets("Sheet2").Range("A10").PasteSpecial Paste:=xlPasteValues

    Worksheets("Sheet1").Range("B1").Copy
    Worksheets("Sheet2").Range("B10").PasteSpecial Paste:=xlPasteValues

    Worksheets("Sheet1").Range("C1").Copy
    Worksheets("Sheet2").Range("C10").PasteSpecial Paste:=xlPasteValues

    Worksheets("Sheet1").Range("D1").Copy
    Worksheets("Sheet2").Range("D10").PasteSpecial Paste:=xlPasteValues

    Worksheets("Sheet1").Range("E1").Copy
    Worksheets("Sheet2").Range("E10").PasteSpecial Paste:=xlPasteValues

    Worksheets("Sheet1").Range("F1").Copy
    Worksheets("Sheet2").Range("F10").PasteSpecial Paste:=xlPasteValues

End Sub

Which works but it does copy these cells into the row below in my purchase orders log.

Hope this is clear and thanks for your help

Public Sub CopyRows() 
    Sheets("Sheet1").Select 
    ' Find the last row of data 
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 
    ' Loop through each row 
    For x = 2 To FinalRow 
        ' Decide if to copy based on column D 
        ThisValue = Cells(x, 4).Value 
        If ThisValue = "A" Then 
            Cells(x, 1).Resize(1, 33).Copy 
            Sheets("SheetA").Select 
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 
            Cells(NextRow, 1).Select 
            ActiveSheet.Paste 
            Sheets("Sheet1").Select 
        ElseIf ThisValue = "B" Then 
            Cells(x, 1).Resize(1, 33).Copy 
            Sheets("SheetB").Select 
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 
            Cells(NextRow, 1).Select 
            ActiveSheet.Paste 
            Sheets("Sheet1").Select 
        End If 
    Next x 
End Sub