遍历多个范围以创建新工作表并更新数据

Question

我试图创建一个新的工作表，从一个范围的不同标识符标记，也有两个单元格从其他范围包括在每次更新。我可以使用不同的标签从一个范围创建新的工作表，并将第二个范围(xRg2)中的第一个单元格添加到每个后续工作表中，但是在遍历第二个范围时没有成功。我知道我需要另一个循环但是我的上一个巢创建了太多的表单。请看下面的例子

Sub Add()
Dim xRg As Excel.Range
Dim xRg2 As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook
Dim wSh2 As Excel.Worksheet
Dim wSh3 As Excel.Worksheet
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Set wSh2 = ThisWorkbook.Sheets("List")
Set wSh3 = ThisWorkbook.Sheets("Template")
Set xRg2 = wSh2.Range("G66:G88")
Application.ScreenUpdating = False
For Each xRg In wSh2.Range("B66:B88")
With wBk
wSh3.Copy after:=.Sheets(.Sheets.Count)
On Error Resume Next
wSh.Name = xRg.Value
wSh.Cells(33,7) = xRg2.Value
If Err.Number = 1004 Then
Debug.Print xRg.Value & "already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
Application.ScreenUpdating = True End Sub

因此，总结一下，这里的目标是每次将范围输入到代码中，并使每个新工作表包含每个范围的第一个值，然后第二个工作表包含每个范围的第二个值，以此类推，直到xRg位于其列表的末尾。我知道这里只有两个量程但是总共是3。也为变量纪律的不佳道歉…

谢谢!

Answer 1

尝试这样做(对不起，我不喜欢所有这些x…变量名)

Sub Add()
Dim c As Range
Dim wb As Workbook, ws As Worksheet, wsList As Worksheet

Set wb = ActiveWorkbook
Set wsList = wb.Worksheets("List")

Application.ScreenUpdating = False

For Each c In wsList.Range("B66:B88").Cells

ThisWorkbook.Sheets("Template").Copy after:=wb.Sheets(wb.Sheets.Count)
Set ws = wb.Sheets(wb.Sheets.Count)  '<< get the just-created sheet copy
On Error Resume Next
ws.Name = c.Value
ws.Cells(33, 7) = c.EntireRow.Columns("G").Value
If Err.Number = 1004 Then
Debug.Print "'" & c.Value & "' already used as a sheet name"
End If
On Error GoTo 0

Next c

Application.ScreenUpdating = True
End Sub