Excel VBA宏问题：无法将源数据复制到Template工作表并自动编号

问题说明 #

我使用网上获取的VBA宏，遍历"Data"工作表C列（C2:C100）的唯一值并为每个值新建工作表，复制粘贴功能正常，但存在两个问题：

1. 无法将数据正确粘贴到"Template"工作表的C列（C14:C100），不清楚如何正确引用该工作表；
2. 希望在数据粘贴完成后，对"Template"工作表C列的新粘贴数据自动编号。

尝试的代码 #

Sub MakeSheets()
Dim lr As Long
Dim ws As Worksheet
Dim i As Integer
Dim ar As Variant
Dim j As Long
Dim rng As Range

Application.ScreenUpdating = False

Set ws = Sheet3 'Sheets code name
lr = ws.Range("C" & Rows.Count).End(xlUp).Row
Set rng = ws.Range("C1:C" & lr)
j = ws.[C1].CurrentRegion.Columns.Count + 1

rng.AdvancedFilter 2, , ws.Cells(1, j), True
ar = ws.Range(ws.Cells(2, j), ws.Cells(Rows.Count, j).End(xlUp))
ws.Columns(j).Clear
    
For i = 1 To UBound(ar)
rng.AutoFilter 1, ar(i, 1)
If Not Evaluate("=ISREF('" & ar(i, 1) & "'!C1)") Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = ar(i, 1)
Else
Sheets(ar(i, 1)).Move After:=Sheets(Sheets.Count)
End If
ws.Range("C2:C" & lr).Resize(, j - 1).Copy [D14] 'Sheets("Template").Range("C14")
Next
ws.AutoFilterMode = False

Sheets("Template").Activate
Range("A1").Activate

Application.ScreenUpdating = True

End Sub

工作表说明 #

Data工作表

• C列（从C2开始）包含带重复项的分类数据，用于提取唯一值生成新工作表。

Template工作表

• 目标粘贴区域为C列的C14:C100，需将筛选后的数据粘贴至此，并为该区域数据添加自动编号。

解决方案 #

修改后的完整代码 #

Sub MakeSheets()
Dim lr As Long
Dim ws As Worksheet
Dim templateWs As Worksheet
Dim i As Integer
Dim ar As Variant
Dim j As Long
Dim rng As Range
Dim lastRow As Long

Application.ScreenUpdating = False

Set ws = Sheet3 'Sheets code name
Set templateWs = Sheets("Template") ' 提前绑定Template工作表

lr = ws.Range("C" & Rows.Count).End(xlUp).Row
Set rng = ws.Range("C1:C" & lr)
j = ws.[C1].CurrentRegion.Columns.Count + 1

' 提取C列唯一值
rng.AdvancedFilter 2, , ws.Cells(1, j), True
ar = ws.Range(ws.Cells(2, j), ws.Cells(Rows.Count, j).End(xlUp))
ws.Columns(j).Clear
    
For i = 1 To UBound(ar)
    rng.AutoFilter 1, ar(i, 1)
    ' 创建或移动目标工作表
    If Not Evaluate("=ISREF('" & ar(i, 1) & "'!C1)") Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = ar(i, 1)
    Else
        Sheets(ar(i, 1)).Move After:=Sheets(Sheets.Count)
    End If
    ' 复制筛选后的可见数据到Template的C14
    ws.Range("C2:C" & lr).Resize(, j - 1).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=templateWs.Range("C14")
Next i

ws.AutoFilterMode = False

' 为Template工作表C列的新数据自动编号（以A列为例）
lastRow = templateWs.Range("C" & Rows.Count).End(xlUp).Row
If lastRow >= 14 Then
    ' 生成序号公式，从1开始
    templateWs.Range("A14:A" & lastRow).Formula = "=ROW()-13"
    ' 可选：将公式转为静态值
    templateWs.Range("A14:A" & lastRow).Value = templateWs.Range("A14:A" & lastRow).Value
End If

Application.ScreenUpdating = True
End Sub

关键修改点 #

1. 正确引用Template工作表：提前用Set templateWs = Sheets("Template")绑定工作表，后续直接通过变量引用，避免依赖激活状态，解决粘贴目标定位错误问题；
2. 复制筛选后的数据：添加.SpecialCells(xlCellTypeVisible)，确保只复制AutoFilter筛选后的可见行数据，避免粘贴空行或无关数据；
3. 自动编号实现：通过公式=ROW()-13生成从1开始的序号（ROW()-13是因为从A14开始，14-13=1），也可根据需求调整编号所在列（比如改为B列只需修改Range参数）；
4. 代码优化：减少重复调用Sheets("Template")，提升代码运行效率和可读性。

内容的提问来源于stack exchange，提问作者Mattilleo