Macro to copy from several cells into another workbook on the next empty row

[mjj347]

I am working on a sheet where I need to export cells B7, B9, E9, B13, F18, F20:F22, F24, F30, F32:F34, and H34 into another workbook where the data will be copied into the next empty row (all on one row). I am then linking this function to a "Submit" button.
I can do most of this my simply recording a macro, but I cannot figure out how to search for an empty row and paste. I am sure there is a way to copy those cells with one command as well, but I have not been able to figure out the syntax, so each copy/paste operation has its own line. The code I have so far is:

Sub Macro3()
'
' Macro3 Macro
'

'
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\mjewell\My Documents\TestTargetSheet.xlsx"
    Windows("TestSourceSheet.xlsm").Activate
    Range("B7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("TestSourceSheet.xlsm").Activate
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("B1").Select
    ActiveSheet.Paste
    Windows("TestSourceSheet.xlsm").Activate
    Range("B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("C1").Select
    ActiveSheet.Paste
    Windows("TestSourceSheet.xlsm").Activate
    Range("E9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("D1").Select
    ActiveSheet.Paste
    Windows("TestSourceSheet.xlsm").Activate
    Range("E13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("E1").Select
    ActiveSheet.Paste
    Windows("TestSourceSheet.xlsm").Activate
    Range("F18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("F1").Select
    ActiveSheet.Paste
    Windows("TestSourceSheet.xlsm").Activate
    Range("F20:F22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Windows("TestSourceSheet.xlsm").Activate
    Range("F24:F30").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("J1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Windows("TestSourceSheet.xlsm").Activate
    Range("F32:F33").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("Q1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Windows("TestSourceSheet.xlsm").Activate

    Range("I7:J13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestTargetSheet.xlsx").Activate
    Range("S1").Select
    Range("S1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub

If anyone doesnt mind showing me how to consolidate this code as well as paste to the next open row, I would really appreciate that. Since I want to learn how to do this better I would also appreciate any comments in your code that you would be willing to make so I can follow it easier.
Thanks!

[NBVC]

Welcome to the forum,

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

PLEASE PM WHEN YOU HAVE DONE THIS AND I WILL DELETE THIS POST

[Bob Phillips]

Try this

Sub Macro3()
Dim wb As Workbook
Dim ws As Worksheet

    Set wb = Workbooks.Open(Filename:= _
        "C:\Documents and Settings\mjewell\My Documents\TestTargetSheet.xlsx")
    Set ws = wb.Worksheets(1)
    With ws
    
        nextrow = .Cells(nextrow, .Rows.Count, "A").End(xlUp).Row
    End With
    
    With Workbooks("TestSourceSheet.xlsm").ActiveSheet
    
        .Range("B7").Copy ws.Cells(nextrow, "A")
        .Range("B9").Copy ws.Cells(nextrow, "B")
        .Range("B13").Copy ws.Cells(nextrow, "C")
        .Range("E9").Copy ws.Cells(nextrow, "D")
        .Range("E13").Copy ws.Cells(nextrow, "E")
        .Range("F18").Copy ws.Cells(nextrow, "F")
        .Range("F20:F22").Copy
        ws.Cells(nextrow, "G").PasteSpecial Paste:=xlPasteValues
        .Range("F24:F30").Copy
        ws.Cells(nextrow, "J").PasteSpecial Paste:=xlPasteValues
       .Range("F32:F33").Copy
        ws.Cells(nextrow, "Q").PasteSpecial Paste:=xlPasteValues
        .Range("I7:J13").Copy
        ws.Cells(nextrow, "S").PasteSpecial Paste:=xlPasteValues
    End With
    
    wb.Save
    wb.Close
    
    Set ws = Nothing
    Set wb = Nothing
End Sub

[mjj347]

Thank you.
That code is generating an error that says 'Wrong number of arguments or invalid property assignments" and it looks to be unhappy with this line

nextrow = .Cells(nextrow, .Rows.Count, "A").End(xlUp).Row

Does TestTargetSheet need to be set as ActiveSheet? I tried to change it but I am still getting that same error.

[mjj347]

Still no luck. Bump

[Bob Phillips]

Correction

Sub Macro3()
Dim wb As Workbook
Dim ws As Worksheet

    Set wb = Workbooks.Open(Filename:= _
        "C:\Documents and Settings\mjewell\My Documents\TestTargetSheet.xlsx")
    Set ws = wb.Worksheets(1)
    With ws
    
        nextrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    With Workbooks("TestSourceSheet.xlsm").ActiveSheet
    
        .Range("B7").Copy ws.Cells(nextrow, "A")
        .Range("B9").Copy ws.Cells(nextrow, "B")
        .Range("B13").Copy ws.Cells(nextrow, "C")
        .Range("E9").Copy ws.Cells(nextrow, "D")
        .Range("E13").Copy ws.Cells(nextrow, "E")
        .Range("F18").Copy ws.Cells(nextrow, "F")
        .Range("F20:F22").Copy
        ws.Cells(nextrow, "G").PasteSpecial Paste:=xlPasteValues
        .Range("F24:F30").Copy
        ws.Cells(nextrow, "J").PasteSpecial Paste:=xlPasteValues
       .Range("F32:F33").Copy
        ws.Cells(nextrow, "Q").PasteSpecial Paste:=xlPasteValues
        .Range("I7:J13").Copy
        ws.Cells(nextrow, "S").PasteSpecial Paste:=xlPasteValues
    End With
    
    wb.Save
    wb.Close
    
    Set ws = Nothing
    Set wb = Nothing
End Sub

[mjj347]

Thank you very much! That code compiled perfectly.
If anyone has the same problem and I made some small changes as shown below. First, the fields I needed to extract from changed slightly and I needed operations for transposing a couple of the paste operations to fit them on a single row, and then set all of the operations to paste cell values only. Thanks again Bob Phillips!

Sub Macro3()
Dim wb As Workbook
Dim ws As Worksheet

    Set wb = Workbooks.Open(Filename:= _
        "C:\Documents and Settings\mjewell\My Documents\TestTargetSheet.xlsx")
    Set ws = wb.Worksheets(1)
    With ws
    
        nextrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    With Workbooks("TestSourceSheet.xlsm").ActiveSheet
    
        .Range("B7").Copy
        ws.Cells(nextrow, "A").PasteSpecial Paste:=xlPasteValues
        .Range("B9").Copy
        ws.Cells(nextrow, "B").PasteSpecial Paste:=xlPasteValues
        .Range("B11").Copy
        ws.Cells(nextrow, "C").PasteSpecial Paste:=xlPasteValues
        .Range("B13").Copy
        ws.Cells(nextrow, "D").PasteSpecial Paste:=xlPasteValues
        .Range("E7").Copy
        ws.Cells(nextrow, "E").PasteSpecial Paste:=xlPasteValues
        .Range("E9").Copy
        ws.Cells(nextrow, "F").PasteSpecial Paste:=xlPasteValues
        .Range("E11").Copy
        ws.Cells(nextrow, "G").PasteSpecial Paste:=xlPasteValues
        .Range("E13").Copy
        ws.Cells(nextrow, "H").PasteSpecial Paste:=xlPasteValues
        .Range("F18").Copy
        ws.Cells(nextrow, "I").PasteSpecial Paste:=xlPasteValues
        .Range("F20:F22").Copy
        ws.Cells(nextrow, "J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        .Range("F24:F30").Copy
        ws.Cells(nextrow, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
       .Range("F32:F33").Copy
        ws.Cells(nextrow, "T").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        .Range("I7:J13").Copy
        ws.Cells(nextrow, "V").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    
    wb.Save
    wb.Close
    
    Set ws = Nothing
    Set wb = Nothing
End Sub