VBA根據單元格值將工作簿拆分為多個工作簿

Question

我有一本包含200多個工作表的工作簿。 每個工作表在單元格M4中都有推銷員姓名。 我想創建一個宏，該宏循環遍歷每個工作表，並根據M4中的值將每個銷售員姓名的主工作簿拆分為單獨的工作簿，因此我可以通過電子郵件將其分別發送給他們。 我認為如果每個銷售人員姓名都有一個數組，會更容易。 誰能為我提供可以執行此過程的代碼？ 為了在我當前的工作簿中進一步說明，推銷員1在M4中有5個工作表，其名稱為M4，推銷員2在其單元格中有3個工作表，其名稱為M4。 因此，對於每個推銷員，我想將所有工作表移動到一個文件中，然后保存。

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

編輯：

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