dynamic复制工作表多次，并使用Excel中的VBA重命名

我想dynamic生成一个自定义数量的工作表，基于我们在Excel中使用VBA定期使用的模板。

我已经创build了一个“概述”页面，我们可以input一个范围来命名新的工作表，但是随后想使用隐藏的“主”工作表来生成这些新工作表的内容。

我下面的代码根据范围生成正确数量的页面，并复制我们的主模板页面，但不会将这两个页面组合在一起，并将它们留在单独的页面中。

Sub test() Dim MyNames As Range, MyNewSheet As Range Set masterSheet = ThisWorkbook.Worksheets("Master") Set MyNames = Range("A1:A6").CurrentRegion ' load range into variable For Each MyNewSheet In MyNames.Cells ' loop through cell range masterSheet.Copy ThisWorkbook.Sheets(Sheets.Count) 'copy master template sheet Sheets.Add.Name = MyNewSheet.Value Next MyNewSheet MyNames.Worksheet.Select ' move selection to original sheet End Sub 

正如你所看到的，代码生成两个命名（空白）工作表，并复制我的主工作表，默认命名为“Master（）”。

Answer 1

所以我们只需要replace这一行：

 Sheets.Add.Name = MyNewSheet.Value 

用这一行：

 ActiveSheet.Name = MyNewSheet.Value 

Answer 2

循环列表并复制表单，如果表单不存在。

 Sub CopyMaster() Dim ws As Worksheet, sh As Worksheet Dim Rws As Long, rng As Range, c As Range Set sh = Sheets("Overview") Set ws = Sheets("Master") With sh Rws = .Cells(Rows.Count, "A").End(xlUp).Row Set rng = .Range(.Cells(1, 1), .Cells(Rws, 1)) End With For Each c In rng.Cells If WorksheetExists(c.Value) Then MsgBox "Sheet " & c & " exists" Else: ws.Copy After:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = c.Value End If Next c End Sub Function WorksheetExists(WSName As String) As Boolean On Error Resume Next WorksheetExists = Worksheets(WSName).Name = WSName On Error GoTo 0 End Function