将工作表复制到具有相同名称的最后一页？

Question

我有一个名为“Book 1”的工作表。我没有问题复制到该工作表之后。我的问题是下一个副本，我已经有了“Book 1”然后“Book 1（2）”我需要复制“Book 1”，但是将它放在“Book 1（2）”之后，依此类推下一个副本。如何跟踪或知道下一份副本的放置位置？我不想把它放在最后，因为最后还有其他标签需要在那里。

Sub CopySheet()
Dim ws As Worksheet
For Each ws In Worksheets
    If Left(ws.Name, 4) = "Book" Then
    Sheets("Book 1").Copy After:=Sheets(ws.Name)
    End If
Next ws
End Sub

Answer 1

通过所有工作表向后循环，并在名称匹配的最后一页之后复制它。

Sub copyMe(ws As Worksheet)

    Dim wb As Workbook
    Dim i As Long

    Set wb = ws.Parent
    For i = wb.Sheets.Count To 1 Step -1
        If ws.Name = Left(wb.Sheets(i).Name, Len(ws.Name)) Then
            ws.Copy After:=wb.Sheets(i)
            Exit For
        End If
    Next i

End Sub

Answer 2

试试这个经过测试的代码。为我工作：

Option Explicit

Sub CopySheet()

    'copy Book 1 sheet
    ThisWorkbook.Worksheets("Book 1").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

    'assign to variable to move later
    Dim wsPlacement As Worksheet
    Set wsPlacement = ActiveSheet

    'load all "Book 1" sheets
    Dim ws As Worksheet
    For Each ws In Worksheets

        If Left(ws.Name, 6) = "Book 1" And ws.Name <> wsPlacement.Name Then

            Dim sSheets As String
            sSheets = sSheets & "," & ws.Name

        End If

    Next ws

    'find last one (by index) and move copy after that one
    'this works so long as sheets stay in numerical order of copy
         'if not it will put sheet at last position (by index) of Book 1 sheets
    sSheets = Mid(sSheets, 2) 'remove leading comma
    Dim arrSheets() As String
    arrSheets = Split(sSheets, ",")

    wsPlacement.Move After:=ThisWorkbook.Worksheets(arrSheets(UBound(arrSheets)))


End Sub