Excel 每一行数据填入一个表格

Sub Button1_Click()
'
' Button1_Click Macro
'
    Dim col%, Myr&, Arr, i&
    Dim Sht As Worksheet, Sht1 As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set Sht1 = Sheet1
    Sht1.Activate
    For Each Sht In Sheets
        If Sht.Name <> Sht1.Name And Sht.Name <> "sheet2" Then Sht.Delete
    Next Sht
    col = 1
        On Error Resume Next
    Myr = [a65536].End(xlUp).Row
    Arr = Range("a1:n" & Myr)
    For i = 2 To UBound(Arr)
        Sheets("sheet2").Copy after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Arr(i, col)
            .[d4] = Arr(i, col): .[g3] = Arr(i, 4): .[g5] = Arr(i, 5): .[d5] = Arr(i, 2)
        End With
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

• sheet1是数据表 sheet2是需要填入数据的模板表
• col是需要以此为表命名的那一列
• d4 g3是模板表需要填入数据的单元格 Arr(i, 4)是数据表对应的单元格

还有个很好用的方法是index+match函数