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

Question

我试图将文件（连接概述）的同一工作表（概述）复制并粘贴到新的工作簿，并且每次在工作表“概览”中重复此操作包含在单元“代码”中的值）根据值列表（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 

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")是在哪里，因此我定义了其范围从工作簿范围。