VBA - 如何将 Excel 中的行从一个工作簿复制到另一个工作簿？

尽管我浏览了许多与我的问题相同的帖子，但没有一个答案满足我的需求。如果您能给我链接，我很乐意阅读。

我有一本带有工作表的工作簿。为简单起见，假设我的工作簿有一个工作表。在我的工作表“Sheet1”中，单元格 A1 到 A4 中有数据。

我想要我的 VBA 代码做的是：

1. 将工作簿“A”的第 1 行（或特别是单元格 A1 到 A4）复制到范围变量“myRange”中
2. 创建一个新工作簿，我们将其称为工作簿“B”
3. 将工作簿 B 的默认“sheet1”命名为“测试名称”
4. 打开工作簿“B”（尽管我意识到 VBA 代码“Workbooks.Add”打开一本新书，因此此步骤可能是多余的，因为 Workbooks.Add 涵盖了第 2 点和第 3 点的一半）
5. 将“myRange”粘贴到“Workbook B”的第一行
6. 将“工作簿 B”保存为名称“测试书”并在方括号中包含时间戳。该文件的文件扩展名还必须是“xls”
7. 关闭“工作簿 B”并返回“工作簿 A”

到目前为止我所拥有的是这样的：

Sub OpenAndSaveNewBook()
    'Declarations
    Dim MyBook As String
    Dim MyRange As Range
    Dim newBook As Workbook

    'Get name of current wb
    MyBook = ThisWorkbook.Name
    Set MyRange = MyBook.Sheets("Sheet1").Range("A1,F1")

    'Create/Open new wb
    newBook = Workbooks.Add

    'Save new wb with XLS extension
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "/" & "TEST-BOOK", _
                            FileFormat:=xlNormal, CreateBackup:=False

    '===NOTE: BEFORE THE FOLLOWING RUNS I NEED TO PERFORM ACTIONS ON CELLS VIA VBA ON
    '===WORKBOOK 'A'. DOES THE NEWLY CREATE WORKBOOK BECOME THE PRIMARY/ACTIVE WORKBOOK
    '===? AND SO THEN DO I NEED TO ACTIVATE WORKBOOK 'A'? 
    ActiveWorkbook.Close savechanges:=True

    'Return focus to workbook 'a'
    MyBook.Activate
End Sub

如您所见，我缺少处理以下内容的代码：

• 将我复制的数据粘贴到新工作簿
• 将新工作簿的sheet1名称更改为其他名称
• 保存时向文件名字符串添加时间戳

最后，我在代码中包含了一个问题，因为我认为我可能对 ActiveWorkbook 方法有误解。据我所知，当代码“Workbooks.Add”运行时，它将成为活动工作簿，即具有焦点的工作簿。这是否会影响 VBA 代码在工作簿“A”上的运行方式？这是否意味着，如果我想添加代码来操作工作簿“A”的单元格，那么我需要使用“MyBook.Activate”，其中“MyBook”保存工作簿“A”的实际标题字符串？

任何帮助将不胜感激。

谢谢， 质量框架

您可以直接执行此操作，而不用上面提到的复制粘贴方式。这也将否定变量的使用。

MyBook.Sheets("Sheet1").Rows("1:4").copy _
newBook.Sheets("Sheet1").Rows("1")

EDIT

我刚刚注意到您的代码有一个错误。

newBook = Workbooks.Add

这行会给你一个错误，因为你必须使用Set

你的代码可以写成

Option Explicit

Sub OpenAndSaveNewBook()
    Dim MyBook As Workbook, newBook As Workbook
    Dim FileNm As String

    Set MyBook = ThisWorkbook

    FileNm = ThisWorkbook.Path & "\" & "TEST-BOOK.xls"
    Set newBook = Workbooks.Add

    With newBook
        MyBook.Sheets("Sheet1").Rows("1:4").Copy .Sheets("Sheet1").Rows("1")

        'Save new wb with XLS extension
        .SaveAs Filename:=FileNm, FileFormat:=xlNormal, CreateBackup:=False

        .Close Savechanges:=False
    End With
End Sub

更多编辑

详细说明使用SET

我建议你看看这篇文章。

LINK: 工作表不起作用 https://stackoverflow.com/questions/10196620/worksheets-does-not-work/10196646#10196646