我正在尝试遍历一行中的某些列并创建新工作表,其中包含我所在的当前列/行的值的名称。
Sub test()
Range("R5").Select
Do Until IsEmpty(ActiveCell)
Sheets.Add.Name = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Loop
End Sub
此代码从 R5 开始正确创建第一个代码,但随后显示宏切换到该工作表并且未完成任务。
答案 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