Question

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

最后，我想让新工作簿由在“代码”单元格中输入的每个代码命名的工作表组成，因此每个工作表将是具有不同编号的“概述”工作表的副本（取决于代码）。

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

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

Answer 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 返回工作表。键入命名的列表范围中的任何值都应生成新的工作簿。

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

Range("Code")将是相关工作表上的单个单元格，但没有指示Range("List")的位置，因此我从工作簿范围定义了它的范围。

复制并粘贴新的工作簿重复

1 个答案: