Excel宏用于创建新工作表

时间:2012-08-22 19:21:04

标签: excel vba excel-vba

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

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

此代码从 R5 开始正确创建第一个代码,但随后显示宏切换到该工作表并且未完成任务。

4 个答案:

答案 0 :(得分:4)

Sheets.Add会自动将您的选择移动到新创建的工作表(就像您手动插入新工作表一样)。因此,Offset基于新工作表的单元格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循环中解决此问题。完成后,将你的选择回到你来自的地方。

答案 1 :(得分:1)

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

答案 2 :(得分:1)

在从列表中命名工作表以处理

时,应始终使用错误处理
  • 工作表名称中的无效字符
  • 工作表名称太长
  • 重复的工作表名称

请更改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

答案 3 :(得分:0)

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

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