vba - 用于创建新工作表的 Excel 宏

Question

我正在尝试遍历一行中的某些列，并使用我所在的当前列/行的值的名称创建新的工作表。

Sub test()
    Range("R5").Select
    Do Until IsEmpty(ActiveCell)
        Sheets.Add.Name = ActiveCell.Value
        ActiveCell.Offset(0, 1).Select
    Loop
End Sub

此代码从R5开始正确创建第一个，但随后宏似乎切换到该工作表并且没有完成任务。

Answer 1

Sheets.Add 会自动将您的选择移动到新创建的工作表（就像您手动插入新工作表一样）。因此，偏移量基于现在已成为您选择的新工作表的单元格 A1 - 您选择一个空单元格（因为工作表是空的）并且循环终止。

Sub test()
Dim MyNames As Range, MyNewSheet As Range

    Set MyNames = Range("R5").CurrentRegion ' load contigeous range into variable
    For Each MyNewSheet In MyNames.Cells    ' loop through cell children of range variable
        Sheets.Add.Name = MyNewSheet.Value
    Next MyNewSheet
    MyNames.Worksheet.Select                ' move selection to original sheet
End Sub

这会更好....您将名称列表分配给 Range 类型的对象变量，并在 For Each 循环中解决此问题。完成后，您将您的选择放回您来自的地方。

Answer 2

Sheets.Add将自动使您的新工作表成为活动工作表。最好的办法是向对象声明变量（这始终是最佳实践）并引用它们。就像我在下面所做的那样：

 Sub test()

    Dim wks As Worksheet
    Set wks = Sheets("sheet1")

    With wks

       Dim rng As Range
       Set rng = .Range("R5")

       Do Until IsEmpty(rng)
            Sheets.Add.Name = rng.Value
            Set rng = rng.Offset(0, 1)
       Loop

   End With

End Sub

Answer 3

从列表中命名要处理的工作表时，应始终使用错误处理

• 工作表名称中的无效字符
• 工作表名称太长
• 重复的工作表名称

请更改Sheets("Title")以匹配标题表的工作表名称（或位置）

出于性能原因，下面的代码使用变量数组而不是工作表名称的范围，尽管关闭ScreenUpdating可能会对用户产生最大的影响

Sub SheetAdd()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strError As String
Dim vArr()
Dim lngCnt As Long
Dim lngCalc As Long

Set ws1 = Sheets("Title")
vArr = ws1.Range(ws1.[r5], ws1.[r5].End(xltoRight))

If UBound(vArr) = Rows.Count - 5 Then
MsgBox "sheet range for titles appears to be empty"
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
End With

For lngCnt = 1 To UBound(vArr)
Set ws2 = Sheets.Add
On Error Resume Next
ws2.Name = vArr(lngCnt, 1)
If Err.Number <> 0 Then strError = strError & vArr(lngCnt, 1) & vbNewLine
On Error GoTo 0
Next lngCnt


With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
End With

If Len(strError) > 0 Then MsgBox strError, vbCritical, "These potential sheet names were invalid"

End Sub

Answer 4

这可能是最简单的。没有错误处理，只是创建工作表的一次性代码

Sub test()
Workbooks("Book1").Sheets("Sheet1").Range("A1").Activate
Do Until IsEmpty(ActiveCell)
    Sheets.Add.Name = ActiveCell.Value
    Workbooks("Book1").Sheets("Sheet1").Select
    ActiveCell.Offset(0, 1).Select
Loop
End Sub