Excel VBA：根据主表客户ID新建工作表并转置填充对应数据

修改思路 #

• 新增新工作表对象存储，避免ActiveSheet的不稳定问题
• 通过结构化表（ListObject）的字段名直接读取对应客户的整行数据，不用硬编码列号，可维护性更强
• 新增固定位置赋值逻辑，适配模板灰色单元格固定引用的需求
• 增加简单重名容错，避免客户ID重复导致的运行报错

注意事项 #

• 请先确认模板工作表中4个灰色空白单元格的实际地址，替换代码中#### 替换为你实际单元格地址标注的对应位置即可
• 如果你需要工作表名完全等于客户ID（不需要加Customer 前缀），可以删除CStr("Customer " & Nm.Text)中的"Customer " &部分

修改后完整代码 #

Option Explicit

Sub SheetsFromTemplate()
    Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wsNew As Worksheet
    Dim shNAMES As Range, Nm As Range
    Dim customerTbl As ListObject
    Dim customerId As String, i As Long
    
    With ThisWorkbook
        Set wsTEMP = .Sheets("Template")
        Set wsMASTER = .Sheets("Customers")
        ' 绑定客户信息结构化表
        Set customerTbl = wsMASTER.ListObjects("Customers")
        Set shNAMES = wsMASTER.Range("Customers[Customer ID]")
        
        Application.ScreenUpdating = False
        For Each Nm In shNAMES
            customerId = CStr(Nm.Text)
            ' 跳过空行
            If customerId = "" Then GoTo NextRow
            
            ' 避免重名报错，先检查是否已有同名工作表
            For i = 1 To .Sheets.Count
                If .Sheets(i).Name = "Customer " & customerId Then
                    MsgBox "客户ID" & customerId & "对应工作表已存在，跳过创建", vbExclamation
                    GoTo NextRow
                End If
            Next i
            
            ' 复制模板
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)
            Set wsNew = .Sheets(.Sheets.Count)
            wsNew.Name = "Customer " & customerId
            
            ' 获取当前客户的整行数据并填充
            With Nm.EntireRow
                ' 以下等号右边的单元格地址请替换为你模板内实际灰色单元格位置
                wsNew.Range("B2") = Nm.Value ' Customer ID 填充位置
                wsNew.Range("B3") = .Cells(, customerTbl.ListColumns("Customer Name").Index).Value ' Customer Name 填充位置
                wsNew.Range("B4") = .Cells(, customerTbl.ListColumns("Description").Index).Value ' Description 填充位置
                wsNew.Range("B5") = .Cells(, customerTbl.ListColumns("Location").Index).Value ' Location 填充位置
            End With
            
NextRow:
        Next Nm
        
        Application.ScreenUpdating = True
    End With
    
    MsgBox "所有工作表创建完成"
End Sub

代码说明 #

• 结构化表取值用ListColumns("字段名")定位列，就算后续调整客户表的字段顺序，填充逻辑也不会出错
• 自动跳过空的客户ID行，避免创建无效空白工作表
• 所有可调整参数都加了注释，可根据实际需求调整命名规则、填充位置等配置

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