VBA – 如何复制Excel工作簿之间的单元格（工作簿名称更改）？

我正在寻找如何编写一个macros，下面的build议。 我想它很容易做，但我无法弄清楚。 提前致谢！

开始

1. 在活动工作表中（在工作簿中，我正在[标题更改但每次格式相同]中运行此macros））复制单元格B9。 将其粘贴到我正在使用的其他工作簿的下一个空白行的列A上[每次运行此过程时都可以拥有相同的标题，或者是唯一打开的其他工作簿]
2. 在活动工作表（在工作簿中我正在运行此macros），复制单元格B8。 粘贴在上面确定的行的B列。
3. 在活动工作表（在工作簿中我正在运行此macros），复制单元格B12。 粘贴在上面确定的行的C列中。
4. 在活动工作表（在我正在运行此macros的工作簿中），复制单元格A17：E17。 粘贴在上面确定的行的D：H中。
5. 在活动工作表（在我正在运行此macros的工作簿中），复制单元格A17：E17。 粘贴在上面确定的行的D：H中。
6. 在活动工作表（在我正在运行此macros的工作簿中），复制单元格G17：N17。 粘贴在上面确定的行的I：P中。

结束

鉴于我缺乏VBA编码能力，我试图logging一个macros，然后调整。 我尝试了尽可能多的select，我可以在谷歌find。 下面似乎是最好的，但不起作用。 （注意：我从上面第一点的B9开始select）。

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

现在，您已经在生成代码方面做了一些努力，下面是您所说的内容的重构版本。 （我没有检查是否与你实际录制的内容相符，但是你logging某些事情的麻烦表明你不是懒得自己做这个事情。）

 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 

这个macros将遍历文件夹中的所有Xlsx文件，并对文件进行上述更改并closures它们。