VBA - 如何在excel工作簿（工作簿名称更改）之间复制单元格？

Question

I am looking for advice on how to write a macro that does the below. I imagine its easy to do, but I can't figure it out. Thanks in advance!

START

1. In the active sheet (in the workbook I am running this macro in [Title changes but same formatting each time]), copy cell B9. Paste in column A on the next blank row of the other workbook I am using [Can have the same title every time I run this process, or just be the only other workbook open]
2. In the active sheet (in the workbook I am running this macro in), copy cell B8. Paste in column B of the row identified above.
3. In the active sheet (in the workbook I am running this macro in), copy cell B12. Paste in column C of the row identified above.
4. In the active sheet (in the workbook I am running this macro in), copy cells A17:E17. Paste in D:H of the row identified above.
5. In the active sheet (in the workbook I am running this macro in), copy cells A17:E17. Paste in D:H of the row identified above.
6. In the active sheet (in the workbook I am running this macro in), copy cells G17:N17. Paste in I:P of the row identified above.

END

Given my lack of vba coding ability I'm trying to record a macro and then adjust. I've tried as many options as I can find on google. The below seems to be the best, but doesn't work. (NB: I start with B9 from point 1 above selected).

Sub Copy_Timesheet()
'
' Copy_Timesheet Macro
'

'
Selection.Copy
Windows("WorkbookB").Activate
Find_Blank_Row()
Dim BlankRow As Long
BlankRow = Range("A65536").End(xlUp).Row + 1
Cells(BlankRow, 1).Select
ActiveCell.Offset(1, 0).Range("A1").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
ActiveCell.Offset(3, 0).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("WorkbookB").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
ActiveCell.Offset(-4, 0).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("WorkbookB").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
ActiveCell.Offset(9, -1).Range("A1:E1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("WorkbookB").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
ActiveCell.Offset(0, 6).Range("A1:H1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("WorkbookB").Activate
ActiveCell.Offset(0, 5).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Answer 1

Now that you have shown some effort in generating the code, here is a refactored version of what you said you were after. (I didn't check to see whether that matched what you actually recorded, but the fact that you went to the trouble of recording something indicated that you weren't just too lazy to do this yourself.)

Sub Copy_Timesheet()
    'Set up some objects to make life easier in the rest of the code
    ' "the active sheet (in the workbook I am running this macro in)"
    Dim wsSrc As Worksheet
    Set wsSrc = ThisWorkbook.ActiveSheet
    'the sheet in the other workbook
    Dim wsDst As Worksheet
    Set wsDst = Workbooks("WorkbookB").Worksheets("destination_sheet_name") 'change sheet name to whatever you need

    Dim BlankRow As Long
    'Fully qualify ranges so that we ensure we are working with the sheet we expect to be
    'Use Rows.Count rather than 65536 just in case we are working in a recent workbook that allows 1048576 rows
    BlankRow = wsDst.Range("A" & wsDst.Rows.Count).End(xlUp).Row + 1

    'In the active sheet (in the workbook I am running this macro in [Title changes but same formatting each time]), copy cell B9. Paste in column A on the next blank row of the other workbook I am using [Can have the same title every time I run this process, or just be the only other workbook open]
    wsDst.Range("A" & BlankRow).Value = wsSrc.Range("B9").Value    

    'In the active sheet (in the workbook I am running this macro in), copy cell B8. Paste in column B of the row identified above.
    wsDst.Range("B" & BlankRow).Value = wsSrc.Range("B8").Value    

    'In the active sheet (in the workbook I am running this macro in), copy cell B12. Paste in column C of the row identified above.
    wsDst.Range("C" & BlankRow).Value = wsSrc.Range("B12").Value    

    'In the active sheet (in the workbook I am running this macro in), copy cells A17:E17. Paste in D:H of the row identified above.
    wsDst.Range("D" & BlankRow & ":H" & BlankRow).Value = wsSrc.Range("A17:E17").Value    

    'In the active sheet (in the workbook I am running this macro in), copy cells A17:E17. Paste in D:H of the row identified above.
    'No need to do this - we just did it

    'In the active sheet (in the workbook I am running this macro in), copy cells G17:N17. Paste in I:P of the row identified above.
    wsDst.Range("I" & BlankRow & ":P" & BlankRow).Value = wsSrc.Range("G17:N17").Value    

End Sub

Answer 2

Sub copysheet()
Dim wb  As Workbook
Dim wb1 As Workbook

application.screenupdating=False
application.DisplayAlerts=False
On error goto resetsettings

MyPath = "C:\Users\foo\" 'The folder containing the files you want to use
MyExtension = "*.xlsx" 'The extension of the file you want  to use

Myfile = Dir(MyPath & MyExtension)
Set wb = ThisWorkbook
While Myfile <> ""
Set wb1 = Workbooks.Open(MyPath & Myfile)
lr = wb1.Sheets(1).Range("A1:A" & Rows.Count).End(xlUp).Row + 1
wb.Sheets(1).Range("B9").Copy Destination:=wb1.Sheets(1).Range("A" & lr)
wb.Sheets(1).Range("B8").Copy Destination:=wb1.Sheets(1).Range("B" & lr)
wb.Sheets(1).Range("B12").Copy Destination:=wb1.Sheets(1).Range("C" & lr)
wb.Sheets(1).Range("A17:E17").Copy Destination:=wb1.Sheets(1).Range("D" & lr & ":H" & lr)
wb.Sheets(1).Range("G17:N17").Copy Destination:=wb1.Sheets(1).Range("I" & lr & ":P" & lr)
wb1.close Savechanges:=True
Myfile = Dir
Wend
ResetSettings:
application.screenupdating=True
application.DisplayAlerts=True
End Sub

This Macro will loop through all Xlsx Files in a folder and make the above changes in the files and closes them.