根据表值创建新工作表时出现名称已存在错误

Question

我写了一个宏，它根据填写的值(可以手动填写)扩展表。之后，第二个宏应该复制某个模板(模板工作表)，并将其名称更改为表中相应的nr。第一次工作是因为工作表还不存在，但是当再次展开表并尝试添加工作表时，会弹出名称已经存在的错误。宏应该跳过这个错误并移动到下一行，但是我似乎无法管理这个。

表扩展宏:

Sub Tableexpension()
'Declare Variables
Dim oSheetName As Worksheet
Dim sTableName As String
Dim loTable As ListObject
Dim loRows As Integer, loColumns As Integer
Dim iNewRows As Integer, iNewColumns As Integer

'Define Variable
sTableName = "Table1"

'Define WorkSheet object
Set oSheetName = Sheets("Overview")

'Define Table Object
Set loTable = oSheetName.ListObjects(sTableName)

'Find number of rows & columns in the table
loRows = loTable.Range.Rows.Count
loColumns = loTable.Range.Columns.Count
'Specify Number of Rows & Columns to add to table
iNewRows = Range("D3")

'Resize the table
loTable.Resize loTable.Range.Resize(loRows + iNewRows)

'Number new table rows
Dim tbl As ListObject
Dim x As Long
Set tbl = ActiveSheet.ListObjects("Table1")
For x = 1 To tbl.ListRows.Count
tbl.DataBodyRange(x, 1) = x
Next x
End Sub

创建宏:

Sub Create_worksheets()

Dim rngCreateSheets As Range
Dim oCell As Range
Dim oTemplate As Worksheet
Dim oSummary As Worksheet
Dim oDest As Worksheet
Set oTemplate = Worksheets("Template")
Set oSummary = Worksheets("Overview")
Set rngCreateSheets = Worksheets("Overview").Range("B6", Range("B6").End(xlDown))
teller = 1
For Each oCell In rngCreateSheets.Cells
oTemplate.Copy After:=Worksheets(Sheets.Count)
Set oDest = ActiveSheet
oDest.Name = oCell.Value
oDest.Range("C5").Value = oCell.Value
oDest.Range("D2").Value = [start_scenario].Offset(teller, 0)
oDest.Range("B3").Value = [start_scenario].Offset(teller, 1)
oDest.Range("B4").Value = [start_scenario].Offset(teller, 2)
oSummary.Hyperlinks.Add Anchor:=oCell, Address:="", SubAddress:= _
oDest.Name & "!C5", TextToDisplay:=oDest.Name
teller = teller + 1
Next oCell

End Sub

我试过使用一些错误代码，但似乎就是不能使它工作。

Answer 1

像这样?

Sub Create_worksheets()
Dim rngCreateSheets As Range
Dim oCell As Range
Dim oTemplate As Worksheet
Dim oSummary As Worksheet
Dim oDest As Worksheet

Set oTemplate = Worksheets("Template")
Set oSummary = Worksheets("Overview")
Set rngCreateSheets = Worksheets("Overview").Range("B6", Range("B6").End(xlDown))

teller = 1

For Each oCell In rngCreateSheets.Cells
If Not WorksheetExists(oCell.Value2) Then
oTemplate.Copy After:=Worksheets(Sheets.Count)
Set oDest = ActiveSheet
oDest.Name = oCell.Value
oDest.Range("C5").Value = oCell.Value
oDest.Range("D2").Value = [start_scenario].Offset(teller, 0)
oDest.Range("B3").Value = [start_scenario].Offset(teller, 1)
oDest.Range("B4").Value = [start_scenario].Offset(teller, 2)
oSummary.Hyperlinks.Add Anchor:=oCell, Address:="", SubAddress:= _
oDest.Name & "!C5", TextToDisplay:=oDest.Name

teller = teller + 1 'Set this outside the If-check if the counter should continue even if you don't add a sheet
End If
Next oCell
End Sub
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function

您应该尽量避免在代码之间放置太多空间，并添加缩进以获得更好的可读性。该函数检查工作表是否存在，如果不存在则返回FALSE，因此您使用If Not WorksheetExists(oCell.Value2) Then只添加工作表。

希望对你有帮助。

Answer 2

添加此函数:

Function GetSheetOrCreateFromTemplate(ByVal shName As Long, templateSh As Worksheet) As Worksheet
Dim sh As Worksheet
On Error Resume Next

Set sh = Worksheets(CStr(shName))
Do While Not sh Is Nothing
shName = shName + 1

Set sh = Nothing
Set sh = Worksheets(CStr(shName))
Loop

On Error GoTo 0

templateSh.Copy After:=Sheets(Sheets.Count)
Set sh = ActiveSheet
sh.Name = CStr(shName)

Set GetSheetOrCreateFromTemplate = sh

End Function

和Create_worksheets()变化:

oTemplate.Copy After:=Worksheets(Sheets.Count)
Set oDest = ActiveSheet
oDest.Name = oCell.Value

:

Set oDest = GetSheetOrCreateFromTemplate(oCell.Value, oTemplate)