根据母表中的ID创建新表并复制数据

Question

我有一个客户表，其格式如下，格式为ListObject - Customer。根据下表，应根据Customer选项卡中的客户数量创建新工作表。

tbody> <<tr>

客户ID	客户名称	描述	位置
Customer1	John Doe	test1	美国
Customer2	希瑟·诺瓦克	test2	英国
Customer3	Allison帕克	test3	通用电气

根据模板中灰色字段在表中的从属项命名模板中的所有灰色字段。用下划线替换单词间距(例如Customer_ID)。在命名单元格时，请确保选择模板而不是工作簿本身。

那么你可以使用下面的代码:

Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wsCustomer As Worksheet
Dim loMaster As ListObject
With ThisWorkbook
Set wsTEMP = .Sheets("Template")                                'sheet to be copied
Set wsMASTER = .Sheets("Customers")              'sheet with names

Set loMaster = wsMASTER.ListObjects("Customer")

Dim r As Range, Customer As String
Dim lc As ListColumn

Application.ScreenUpdating = False

For Each r In loMaster.DataBodyRange.Rows
Customer = r.Cells(1, 1)
wsTEMP.Copy After:=.Sheets(.Sheets.Count)
Set wsCustomer = ActiveSheet

With wsCustomer
.Name = Customer

For Each lc In loMaster.ListColumns
'Assumption: per each list column there is a named range on the sheet
'empty spaces in column names are replaced by an underscore in range name
.Range(Replace(lc.Name, " ", "_")) = Intersect(lc.DataBodyRange, r)
Next
End With
Next
Application.ScreenUpdating = True                           'update screen one time at the end
End With
MsgBox "All sheets created"
End Sub

代码遍历listobject的所有行(first for-each)

按行创建新工作表，并根据第一个单元格命名。

然后通过将字段名映射到列表列名，将值写入每个灰色字段。(第二个for - each)

客户表中的相关值是通过将listcolumn-range与第一个for-each循环中的行相交来找到的。