VBA基于列表创建工作表

Question

我想根据工作表"客户"中的列表自动创建工作表。此工作表具有客户端名称(从单元格A2开始)，VBA代码正在读取此列表并为每个单元格值创建一个工作表。

我在这个论坛上发现了一些代码，但它在第9行(Set MyRange2 = .Range(MyRange, .Rows.Count, "A").End(xlUp))上抛出了"运行时错误450:参数数量错误或无效的属性分配"。我不是一个VBA开发人员，所以搜索这个错误并没有真正意味着很多给我。这段代码可能有什么问题?

Sub insertSheets()
Dim myCell As Range
Dim MyRange As Range
Dim MyRange2 As Range
With Sheets("Clients")
Set MyRange = .Range("A2")
Set MyRange2 = .Range(MyRange, .Rows.Count, "A").End(xlUp)
End With
For Each myCell In MyRange2
If Not myCell.Value = vbNullString Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = myCell.Value
End If
Next myCell
End Sub

Thanks for the help

Answer 1

从列表中添加工作表

错误

Set MyRange2 = .Range(MyRange, .Cells(.Rows.Count, "A").End(xlUp))
' or (no need for 'Set MyRange = .Range("A2")'):
'Set MyRange2 = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

Option Explicit
Sub InsertSheets()
Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Clients")

Dim srg As Range
Set srg = sws.Range("A2", sws.Cells(sws.Rows.Count, "A").End(xlUp))

Dim sCell As Range
Dim sValue As Variant
Dim dws As Worksheet
Dim wsCount As Long
Dim ErrNum As Long

For Each sCell In srg.Cells
sValue = sCell.Value
If Not IsError(sValue) Then ' ignore error values
sValue = CStr(sValue)
If Len(sValue) > 0 Then ' ignore blanks
On Error Resume Next
Set dws = ThisWorkbook.Worksheets(sValue)
On Error GoTo 0
If dws Is Nothing Then
Set dws = ThisWorkbook.Worksheets.Add( _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
On Error Resume Next
dws.Name = sValue
ErrNum = Err.Number
On Error GoTo 0
If ErrNum = 0 Then ' valid name
wsCount = wsCount + 1
Else ' invalid name; delete the worksheet
Application.DisplayAlerts = False
dws.Delete
Application.DisplayAlerts = True
End If
' Else ' worksheet already exists; do nothing
End If
Set dws = Nothing
' Else ' is blank; do nothing
End If
' Else ' is error value; do nothing
End If
Next sCell
MsgBox "Worksheets created: " & wsCount
End Sub