复制和粘贴新工作簿重复答案

【问题标题】：copy and paste in new workbook reiteration复制和粘贴新工作簿重复
【发布时间】：2015-09-25 09:30:09
【问题描述】：

我正在尝试将文件（连接概述）的相同工作表（概述）复制并粘贴到新工作簿中，并在每次工作表“概述”中的值（单元格“代码”中包含的值") 根据值列表 (List) 更改 - 因此更改工作表“概览”的输出。

最后，我希望新工作簿由单元格“代码”中估算的每个代码命名的工作表组成，因此每个工作表都是具有不同数字的“概述”工作表的副本（取决于代码）。

我正在使用它，但我显然陷入了迭代：

Sub CopyItOver()
    x = 1
    For Each Lista In Range("List")
        Worksheets("Overview").Range("Code") = Lista
        Calculate
        Set NewBook = Workbooks.Add
        Workbooks("Connection Overview.xlsm").Worksheets("Overview").Copy
        NewBook.Sheets(“Sheet(x)”).Paste
        x=x+1
    Next
End Sub

【问题讨论】：

您是否打算在保存和关闭新工作簿之前为其命名？

标签： vba excel copy-paste

【解决方案1】：

当您复制没有目标的工作表时，副本会在新的空白工作簿中创建。剩下的就是控制新的ActiveWorkbook 并保存它。

右键单击工作表的名称选项卡并选择查看代码。当 VBE 打开时，将以下内容粘贴到标题为 Book1 - Sheet1 (Code) 的工作表代码窗格中。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Code")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Dim fn As String, rng As Range
        fn = ThisWorkbook.Path & Chr(92) & "OVRVW_" & Format(Now, "yyyymmdd_hhmmss")
        Set rng = ThisWorkbook.Names("List").RefersToRange
        If Not IsError(Application.Match(Target.Value2, rng, 0)) Then
            Target.Parent.Copy
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=fn, FileFormat:=xlOpenXMLWorkbook
            ActiveWorkbook.Close SaveChanges:=False
        End If
    End If
bm_Safe_Exit:
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

点击 Alt+Q 返回工作表。键入命名 List 范围内的任何值都应生成一个新工作簿。

Workbook.SaveAs method 使用提供的文件名和原始工作簿的路径。新工作簿保存为 n .XLSX 类型的工作簿。

Range("Code") 将是相关工作表上的单个单元格，但没有迹象表明 Range("List") 在哪里，所以我从工作簿范围定义了它的范围。

【讨论】：