Copy data from several ranges to new sheet

[jpruffle]

Hi,

I am working on a spreadsheet that enables calls to be monitored for QA. The first sheet enables the user to enter data, then a button can be used to submit the data which should place it in the 'Data' sheet with each submission entered on a new row. As the data being entered is in several different ranges I cannot get the next set of data entered onto the next row on the 'Data' sheet, can you advise please? My code is below and I've attached the workbook.

Thank you in advance. JP

Sub CopyData()

  Sheets("QM Form").Select
    Range("C3:C6").Copy
    Sheets("Data").Select
    'NextRow = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row + 1
    'Columns("A").Find("", Cells(Rows.Count, "A")).Offset(1, 0).Select
    
    Range("A5000").End(xlUp).Offset(1, 0).Select
    'Range("AT4").End(xlToLeft).Select
   ' Range("B5000").End(xlUp).Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        
   Sheets("QM Form").Select
    Range("H4:H9").Copy
    Sheets("Data").Select
    Range("AT4").End(xlToLeft).Offset(0, 1).Select
    'Range("B5000").End(xlUp).Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
   
   Sheets("QM Form").Select
    Range("H11:H40").Copy
    Sheets("Data").Select
    Range("AT4").End(xlToLeft).Offset(0, 1).Select
    'Range("B5000").End(xlUp).Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
   
   Sheets("QM Form").Select
    Range("A43").Copy
    Sheets("Data").Select
    Range("AT4").End(xlToLeft).Offset(0, 1).Select
    'Range("B5000").End(xlUp).Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
   
   Sheets("QM Form").Select
    Range("N3").Copy
    Sheets("Data").Select
    Range("AT4").End(xlToLeft).Offset(0, 1).Select
    'Range("B5000").End(xlUp).Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
   
   Sheets("QM Form").Select
    Range("N17").Copy
    Sheets("Data").Select
    Range("AT4").End(xlToLeft).Offset(0, 1).Select
    'Range("B5000").End(xlUp).Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
      
   
End Sub