将数据拆分到各表1

将对应部门的内容放入对应表

有两种做法

for循环

①遍历表1，找出d列中等于其他表名的行
②若等于对应的表名，则复制该行，并粘贴复制到下一个空行
③最外层嵌套for循环控制需要粘贴的表

Sub 循环()
Dim i, j, k As Integer
For j = 2 To Sheets.Count
'注意 此处的range要注明是哪张表'
For i = 2 To Sheet1.Range("a65536").End(xlUp).Row
    If Sheet1.Range("d" & i) = Sheets(j).Name Then
        '定义k变量表示表中当前一共有多少行内容'
        k = Sheets(j).Range("a65536").End(xlUp).Row
        Sheet1.Range("d" & i).EntireRow.Copy Sheets(j).Range("a" & k + 1)
    End If
Next
Next
End Sub

筛选的做法

①对表1的d列进行筛选
②将筛选得到的内容粘贴到对应表

Sub 筛选()
Dim i As Integer
Dim sht As Worksheet    

i = Sheet1.Range("a65536").End(xlUp).Row
For Each sht In Worksheets
    If sht.Name <> 数据 Then
Sheet1.range(“a1:f”&i).AutoFilterField:=4,Criterial:=Sheets(i).Name
        Sheet1.Range("a1:f" & i).Copy sht.Range("a1")
    End If
Next
End Sub

清空各表

Sub qk()
Dim l As Integer
For l = 2 To Sheets.Count
    Sheets(l).Range("a2:f10000").ClearContents
Next
End Sub

若要再for循环中调用该函数，直接用 call qk 即可