从现有（未知命名）工作簿创建表单副本到新的（未知命名）工作簿

Question

我有一个将由多个用户使用的现有工作簿（他们将唯一地命名工作簿 - 如果需要，我可以设置一个工作簿代号，但不知道如何执行此操作？）。

我需要创建一个打开一个新工作簿的宏（大概我不会知道它的名字？因为它可能是＆＃39; Book1＆＃39;，＆＃39; Book2＆＃39;， ＆＃39; Book3＆＃39;等？），然后返回到存储宏的原始工作簿，并复制几个（如果需要，可以一次一个）工作表（我知道这些工作表的名称）和将它们作为新工作表粘贴到我在开始时创建的新工作簿中。宏不需要保存文件（实际上它不是因为我希望用户在任何最方便用户的地方保存新工作簿）。

我试图展示宏会做什么，显示出一个明显的问题，即我不知道我正在创建/复制/粘贴的工作簿的名称。

任何帮助，非常感谢！

Sub CopySheetintoNewWorkbook()

'Macro opens new / blank workbook (name unknown?)'
    Workbooks.Add

'Macro goes back to original workbook where macro is saved (of which the name is unknown to the macro - i.e., users can and will change it)'
    Windows("UnknownWorkbookName-1").Activate

'Macro goes to a sheet which can be named and will be known, so this is no problem'
    Sheets("KnownSheet").Select
'Macro creates a copy of the sheet and pastes it as a new sheet within the new, unknown named workbook'
    Application.CutCopyMode = False
    Sheets("KnownSheet").Copy Before:=Workbooks("UnknownWorkbookName-2").Sheets(1)

End Sub

Answer 1

我们要复制 Sheet1 和 Sheet2 。

这取决于一个小技巧：

Sub qwerty()
    Dim wb1 As Workbook, wbNEW As Workbook
    Set wb1 = ActiveWorkbook
    Sheets("Sheet1").Copy
    Set wbNEW = ActiveWorkbook
    wb1.Sheets("Sheet2").Copy after:=wbNEW.Sheets(1)
End Sub

当执行第一个 .Copy 时，会创建一个新的工作簿，它将成为 ActiveWorkbook ........其余的很容易。

修改＃1：

如果我们要复制一组工作表，那么我们可以创建一个工作表名称数组并循环遍历该数组，一次复制一个工作表：

Sub qwerty()
    Dim wb1 As Workbook, wbNEW As Workbook
    Dim ary() As String, s As String, i As Long

    s = "Larry,Moe,Curly"
    ary = Split(s, ",")
    Set wb1 = ActiveWorkbook
    i = 1

    For Each a In ary
        If i = 1 Then
            Sheets(a).Copy
            Set wbNEW = ActiveWorkbook
        Else
            wb1.Sheets(a).Copy after:=wbNEW.Sheets(1)
        End If
        i = 2
    Next a

    wbNEW.Activate
End Sub