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

Excel Macro for creating new worksheets

提问by Matthew

I am trying to loop through some columns in a row and create new worksheets with the name of the value of the current column/row that I am in.

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

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

This code creates the first one correctly starting at R5but then it appears that the macro switches to that worksheet and doesn't complete the task.

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

回答by MikeD

The Sheets.Add automatically moves your selection to the newly created sheet (just like if you insert a new sheet by hand). In consequence the Offset is based on cell A1 of the new sheet which now has become your selection - you select an empty cell (as the sheet is empty) and the loop terminates.

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

This will work better .... you assign the list of names to an object variable of type Range and work this off in a For Each loop. After you finish you put your Selection back to where you came from.

这会更好地工作......您将名称列表分配给 Range 类型的对象变量，并在 For Each 循环中进行处理。完成后，将您的选择放回原处。

回答by Scott Holtzman

Sheets.Addwill automatically make your new sheet the active sheet. Your best bet is to declare variables to your objects (this is always best practice) and reference them. See like I've done below:

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

回答by brettdj

Error handling should always be used when naming sheets from a list to handle

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

• invalid characters in sheet names
• sheet names that are too long
• duplicate sheet names

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

Pls change Sheets("Title")to match the sheet name (or position) of your title sheet

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

The code below uses a variant array rather than a range for the sheet name for performance reasons, although turning off ScreenUpdatingis likely to make the biggest difference to the user

出于性能原因，下面的代码使用变体数组而不是工作表名称的范围，尽管关闭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

回答by AOGSTA

This is probably the simplest. No error-handling, just a one-time code to create sheets

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

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