VBA分割ブックをセルの値に基づいて複数のブックに分割

Question

私は200を超えるワークシートを持つワークブックを持っています。各ワークシートには、セルM4にセールスマン名があります。私は各ワークシートをループするマクロを作成し、M4の値に基づいてセールスマン名ごとにマスターブックを別のワークブックに分割するので、別々にメールで送信できます。私は、セールスマンの名前が並んでいれば、それは簡単だろうと思っています。誰でもこのプロセスを実行できるコードで私を助けることができますか？私の現在のワークブックでさらに説明するために、セールスマン1はM4に5つのワークシートを持ち、Salesmen 2にはセルM4に3つのワークシートがあります。だから各セールスマンのために、私はすべてのワークシートを1つのファイルに移動して保存したいと思っています。

Answer 1

Sub WayEatFresh() 

For i = 1 To ThisWorkbook.Sheets.Count 
    NewWorkbookName = ThisWorkbook.Sheets(i).Cells(4, 13).Value 
    ThisWorkbook.Sheets(i).Copy 
    ActiveWorkbook.SaveAs "C:\YourFilePath\" & NewWorkbookName & ".xlsx", FileFormat:=51 
Next 

End Sub 

EDIT：

Sub WayEatFresh() 

Salesmen = "" 
For i = 1 To ThisWorkbook.Sheets.Count 
    If InStr(Salesmen, ThisWorkbook.Sheets(i).Cells(4, 13).Value) = 0 Then 
    If Salesmen = "" Then 
     Salesmen = ThisWorkbook.Sheets(i).Cells(4, 13).Value 
    Else 
     Salesmen = Salesmen & "->" & ThisWorkbook.Sheets(i).Cells(4, 13).Value 
    End If 
    End If 
Next 

SalesmanArray = Split(Salesmen, "->") 

For i = 0 To UBound(SalesmanArray) 
    NewWorkbookName = SalesmanArray(i) 
    Set NewWB = Workbooks.Add 
    For j = 1 To ThisWorkbook.Sheets.Count 
     If ThisWorkbook.Sheets(j).Cells(4, 13).Value = SalesmanArray(i) Then 
      ThisWorkbook.Sheets(j).Copy After:=NewWB.Sheets(1) 
     End If 
    Next 

    NewWB.SaveAs ("C:\YourLocation\" & NewWorkbookName & ".xlsx") 
    NewWB.Close 
    Set NewWB = Nothing 
Next 

End Sub