添加一个循环将主信息拆分为单独的工作表

我有一份公司名单和董事薪金每年。 这是一个长约200行的长列表。 许多董事都为一家以上的公司工作。

我想分割每个董事信息并将其粘贴到工作表中。 每个导演一个新的工作表。

掌握excel文件

Name Company Salary Adam A Company $20,000 Boris B Company $5,000 Adam S Company $2,000 Carl C Company $81,000 ... 

新的Excel文件 – 工作表1

 Name Company Salary Adam A Company $20,000 Adam S Company $2,000 

新的Excel文件 – 工作表2

 Boris B Company $5,000 

这是我写的VBA代码。 它一次只适用于一个导演，我如何循环播放，以便每位导演都能运行？

 Sub sort() lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row For i = 1 To lastrow If Cells(i, 1) = "Adam" Then Range(Cells(i, 1), Cells(i, 5)).Select Selection.Copy Workbooks.Open Filename:="C:\summary.xlsm" Dim p As Integer, q As Integer p = Worksheets.Count For q = 1 To p If ActiveWorkbook.Worksheets(q).Name = "Adam" Then Worksheets("Adam").Select End If Next q erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row ActiveSheet.Cells(erow, 1).Select ActiveSheet.Paste ActiveWorkbook.Save ActiveWorkbook.Close Application.CutCopyMode = False End If Next i End Sub