创build一个工作表的副本，并根据列表进行命名

您好，我正在尝试在工作簿中创build一个工作表的副本中的每个项目范围内，然后根据该范围中的当前单元格的值重命名工作表。 这是以前的工作，但现在它没有命名新的床单。 如果我做空白工作表，它会命名他们，但是如果我复制工作表，它不会正确命名工作表。 我也试图将每张纸上的C1值设置为范围内的值。 以下是我的代码：

Sub CreateSEMSheets() On Error GoTo GetOut Dim MyCell As Range, MyRange As Range Set MyRange = Sheets("Strategic End Market Data").Range("SEMListGenerated") For Each MyCell In MyRange If MyCell.Value = "" Then GoTo GetOut Sheets("StrategicMktPlan").Copy After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = "SMP - " & MyCell.Value Sheets(Sheets.Count).Range("C1").Value = MyCell.Value Next MyCell GetOut: End Sub 

请帮忙！！！ 提前致谢。

编辑：我想出了为什么它不工作 – 有一个隐藏的工作表是工作簿中的最后一张，它是反复重命名。 任何想法如何防止这一点？

Answer 1

在Worksheet对象的Copy（）方法之后，新创build的工作表是活动的 ：

 For Each MyCell In MyRange If MyCell.Value = "" Then GoTo GetOut Sheets("StrategicMktPlan").Copy After:=Sheets(Sheets.Count) With ActiveSheet .Name = "SMP - " & MyCell.Value .Range("C1").Value = MyCell.Value End With Next MyCell 

Answer 2

根据你的编辑，你可以使用这个：

 Sub VisibleSheetsCount() 'UpdatebyKutoolsforExcel20150909 ' https://www.extendoffice.com/documents/excel/3187-excel-count-visible-sheets.html    Dim xSht As Variant    Dim I As Long    For Each xSht In ActiveWorkbook.Sheets        If xSht.Visible Then I = I + 1    Next    MsgBox I & " sheets are visible", , "Kutools for Excel" End Sub 

然后做。 .Copy(After:=Sheets(I))我认为会工作。