Excel VBA实现按列表复制模板工作表并重命名、写入对应单元格值

你已完成的模板复制、按列表重命名逻辑可直接复用，仅需补充单元格赋值逻辑、增加必要的容错判断即可实现全部需求，以下是可直接运行的完整代码：

Sub CopySheetRenameFromCell()
    Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
    Dim newSheet As Worksheet
    ' 绑定模板工作表和数据源工作表
    Set sh1 = Sheets("template")
    Set sh2 = Sheets("point")
    
    ' 遍历point表B列从B6开始的所有有效数据行
    For Each c In sh2.Range("B6", sh2.Cells(sh2.Rows.Count, "B").End(xlUp))
        ' 跳过B列内容为空的行
        If Trim(c.Value) <> "" Then
            ' 复制模板到工作簿末尾
            sh1.Copy After:=Sheets(Sheets.Count)
            Set newSheet = ActiveSheet
            
            ' 处理工作表重命名（忽略重名、非法字符导致的报错）
            On Error Resume Next
            newSheet.Name = c.Value
            ' 仅当重命名成功时，写入对应数值
            If Err.Number = 0 Then
                ' 同行C列值写入新表C2，同行D列值写入新表F2
                newSheet.Range("C2").Value = c.Offset(0, 1).Value
                newSheet.Range("F2").Value = c.Offset(0, 2).Value
            End If
            ' 恢复默认错误捕获
            On Error GoTo 0
        End If
    Next
End Sub

核心改动说明 #

• 新增newSheet对象变量直接绑定新生成的工作表，减少对ActiveSheet的依赖，避免工作表切换导致的定位错误
• 对取B列最后一行的Rows.Count增加数据源工作表sh2的限定，避免因当前激活工作表行数不同导致的遍历范围错误
• 增加空行判断，自动跳过B列无内容的行，不会生成无效工作表
• 增加重命名结果校验，只有工作表命名成功（无重名、无非法命名字符）时才执行数值写入，避免数据错填
• 用Offset偏移取值，直接取当前遍历行的C、D列对应值，写入新表指定单元格，逻辑和需求完全匹配

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