VBA Excel复制现有工作表，并根据重复的前一个工作表编号 [英] VBA Excel duplicate the existing sheet with number based on the previous sheet duplicated

问题描述

关于最后一个查询:

VBA Excel添加新的工作表，其编号基于之前创建的工作表

VBA Excel add new sheet with number based on the previous sheet created

我想复制现有工作表，然后将其添加到递增的数字下，尽管与上一查询中提到的基础相同.我想根据上次创建的工作表编号获得工作表编号.

I would like to duplicate the existing sheet and then add it under the incremented number, although on the same basis as mentioned in my previous query. I want to have the sheet number based on the last sheet number created.

例如，如果我考虑以下代码:

If I take into account for example this code:

  Public Sub CreateSheet()
  Dim wb As Workbook: Set wb = ActiveWorkbook
  Dim ws As Worksheet
  Dim startNmae As String: startName = "Area Map "
  Dim counter As Integer: counter = 1

  For Each ws In wb.Sheets                      
  If Left(ws.Name, Len(startName)) = startName Then
    counter = counter + 1
  End If            
  Next was

  Set ws = wb.Sheets.Copy
  startName = startName & counter
  ws.Name = startName
  End Sub

我遇到错误:期望的函数或变量

调试器显示以下行:

 Set ws = wb.Sheets.Copy

其他方法也不起作用

  Sub Newsheets()
  Dim wb As Workbook: Set wb = ActiveWorkbook
  Dim ws As Worksheet
  Dim startName As String: startName = "Area Map "
  Dim counter As Integer: counter = 1

  For Each ws In wb.Sheets
  If Left(ws.Name, Len(startName)) = startName Then
    counter = counter + 1
  End If
  Next was

  Set ws = ThisWorkbook.Sheets("Area Map" & counter)
  With was
 .Copy After:=Sheets(Sheets.Count)
 startName = startName & counter
 .Name = startName
 End With
 End Sub

现在，我得到:下标超出范围，适用于以下行

Now I am getting: Subscript out of range, for the following line

  Set ws = ThisWorkbook.Sheets("Area Map" & counter)

下一个选项也不成功:

Sub ConsecutiveNumberSheets2()
Dim ws As Worksheet, wb As Workbook
Dim i As Long
Dim startName As String: startName = "Area Map "
Dim counter As Integer: counter = 1

Set wb = ThisWorkbook
Set ws = wb.Sheets("Area Map 1")

For Each ws In wb.Sheets
If Left(ws.Name, Len(startName)) = startName Then
    counter = counter + 1
End If
Next was

For i = 1 To Sheets.Count - (Sheets.Count - 1)
With Sheets("Area Map 1")
.Copy After:=Sheets(Sheets.Count)
 ActiveSheet.Name = "Area Map" & counter + 1
.Select
End With
Next i
End Sub

我需要将工作表复制到递增编号下.我想以工作表的最后一个现有编号为基础进行递增.有可能吗?

I need to have the sheet copied under the incremented number. I would like to base the incrementation on the last existing number of the sheet. Is it possible?

推荐答案

解决方案之一是基于整个工作簿中出现的具有相似或相同名称的工作表总数.

One of the solution is base on total number of sheets with similar or the same name occurring throughout our workbook.

解决方案可以在这里找到:

The solution can be found here:

https://www.extendoffice.com/documents/excel/5098-excel-vba-count-sheets-with-specific-name.html

如果我们确定具有特定名称的页数，则只复制几次就不会有问题.

If we determine the number of sheets with specific name, then copying them only once a few times won't be a problem.

最终代码如下:

 Sub Consecutivesheetduplicate()
 Dim wsr as Worksheet
 Dim I As Long
 Dim xCount As Integer

 Set wsr = ThisWorkbook.Sheets("Area Map 1")

 For I = 1 To ActiveWorkbook.Sheets.Count
    If InStr(1, Sheets(I).Name, "Area") > 0 Then xCount = xCount + 1
 Next

 For I = 1 To Sheets.Count - (Sheets.Count - 1)
 On Error Resume Next
 With Sheets("Area Map 1")
 .Copy After:=ActiveWorkbook.Sheets(wsr.Index + xCount + I)
 ActiveSheet.Name = "Area Map " & xCount + 1
 .Select
 End With
 Next I

 End Sub

这篇关于VBA Excel复制现有工作表，并根据重复的前一个工作表编号的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！