Vba 添加工作表时更新sheets.count值

我正在编写宏以复制工作表并将其添加到工作簿中的特定位置。此宏将用于具有不同工作表数量的工作簿，因此我希望它继续复制和添加工作表，直到没有更多工作表

Sub Macro()

Dim x As Integer

For x = 3 To Sheets.Count Step 3
    Sheets(x).Select
    Sheets(x).Copy Before:=Sheets(x + 3) 

A bunch more code...

Next

宏的运行范围显然是从3到工作表的总数，但由于工作表的总数在每个步骤后都会发生变化（由于复制/添加工作表），因此宏在到达工作簿末尾之前就会停止运行（我猜是因为当计数器达到sheets.count的起始值时，它就会停止运行）。关于如何使宏一直持续到最后，有什么建议吗？

---

这是我第一次编写代码，所以请温柔一点：）

让我们假设您想要添加

x

工作表，这样您就可以达到工作表计数

y

。但是，您希望在工作簿中最后一张名为

End

的工作表之前创建所有这些工作表。一种方法如下：

Sub AddMoreSheets()

    ShCount = ThisWorkbook.Sheets.Count
    TargetCount = 7
    SheetsToAdd = TargetCount - ShCount

    Do Until SheetsToAdd = 0
        ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Sheets("End")
        SheetsToAdd = SheetsToAdd - 1
    Loop

End Sub

但是，如果您不总是确定最后一张工作表的名称是否为

End

，该怎么办？一种方法是：

Sub AddMoreSheets2()

    ShCount = ThisWorkbook.Sheets.Count
    TargetCount = 7
    SheetsToAdd = TargetCount - ShCount

    Do Until SheetsToAdd = 0
        ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Sheets(Sheets.Count)
        SheetsToAdd = SheetsToAdd - 1
    Loop

End Sub

但是，出于某种原因，您确实希望为此使用

for循环。这里有一个窍门：您想根据名为
Start
的工作表中的列表来命名它们！这里有一种方法：

Sub AddMoreSheets3()

    Dim ListOfNames As Variant, ShName As Variant

    ListOfNames = Sheets("Start").Range("A1:A5").Value 'Modify accordingly.

    For Each ShName In ListOfNames
        Set NewSht = ThisWorkbook.Sheets.Add(Before:=Sheets(Sheets.Count))
        NewSht.Name = ShName
    Next ShName

End Sub

希望这有帮助
 假设您要添加
x
工作表，以便可以达到工作表计数
y
。但是，您希望在工作簿中最后一张名为
End
的工作表之前创建所有这些工作表。一种方法如下：

Sub AddMoreSheets()

    ShCount = ThisWorkbook.Sheets.Count
    TargetCount = 7
    SheetsToAdd = TargetCount - ShCount

    Do Until SheetsToAdd = 0
        ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Sheets("End")
        SheetsToAdd = SheetsToAdd - 1
    Loop

End Sub

但是，如果您不总是确定最后一张工作表的名称是否为
End
，该怎么办？一种方法是：

Sub AddMoreSheets2()

    ShCount = ThisWorkbook.Sheets.Count
    TargetCount = 7
    SheetsToAdd = TargetCount - ShCount

    Do Until SheetsToAdd = 0
        ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Sheets(Sheets.Count)
        SheetsToAdd = SheetsToAdd - 1
    Loop

End Sub

但是，出于某种原因，您确实希望为此使用
for循环。这里有一个窍门：您想根据名为
Start
的工作表中的列表来命名它们！这里有一种方法：

Sub AddMoreSheets3()

    Dim ListOfNames As Variant, ShName As Variant

    ListOfNames = Sheets("Start").Range("A1:A5").Value 'Modify accordingly.

    For Each ShName In ListOfNames
        Set NewSht = ThisWorkbook.Sheets.Add(Before:=Sheets(Sheets.Count))
        NewSht.Name = ShName
    Next ShName

End Sub

希望这有帮助
 你为什么要复制纸张而不是移动它们？这似乎只是为了没有真正的目的而膨胀文件…我现在无法测试它（从平板电脑输入）。您可以在while循环中再次使用递归函数或调用计数，或者使用GOTO语句。我会尝试使用
whilexwhile执行while循环为什么要复制工作表而不是移动它们？这似乎只是为了没有真正的目的而膨胀文件…我现在无法测试它（从平板电脑输入）。您可以在while循环中再次使用递归函数或调用计数，或者使用GOTO语句。我会尝试使用
whilex进行while循环