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

qwe*_*ace 6 excel vba excel-vba excel-2010

尽管有许多帖子我看起来与我的问题一脉相承,但没有一个答案满足我的要求.如果你能把我联系到一个我很乐意读它.

我有一个带工作表的工作簿.为简单起见,假设我的工作簿有一个工作表.在我的名为"Sheet1"的工作表中,单元格A1到A4中有数据.

我希望我的VBA代码做的是:

  1. 将工作簿'A'的第1行(或特定单元格A1到A4)复制到范围变量'myRange'
  2. 创建一个新工作簿,让我们称之为工作簿'B'
  3. 为Workbook'B的默认"sheet1"提供"Test Name"的新名称
  4. 打开工作簿'B'(虽然我意识到VBA代码"Workbooks.Add"打开一本新书,所以这一步可能是多余的,因为Workbooks.Add涵盖了第2点和第3点的一半)
  5. 将'myRange'粘贴到'Workbook B'的第一行
  6. 保存名为"Test Book"的"工作簿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
Run Code Online (Sandbox Code Playgroud)

如您所见,我缺少将处理的代码:

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

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

任何帮助将不胜感激.

谢谢,QF

Sid*_*out 10

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

MyBook.Sheets("Sheet1").Rows("1:4").copy _
newBook.Sheets("Sheet1").Rows("1")
Run Code Online (Sandbox Code Playgroud)

编辑

我刚发现你的代码出错了.

newBook = Workbooks.Add
Run Code Online (Sandbox Code Playgroud)

这条线将为您提供必须使用的错误 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
Run Code Online (Sandbox Code Playgroud)

更多编辑

阐述使用 SET

我建议你看看这篇文章.

链接:工作表不起作用