Question

我有一本包含200多个工作表的工作簿。每个工作表在单元格M4中都有销售人员名称。我想创建一个循环遍历每个工作表的宏，并根据M4中的值将主工作簿拆分为每个销售人员名称的单独工作簿，因此我可以单独通过电子邮件发送给他们。我认为如果我有一个每个推销员名称的数组会更容易。任何人都可以帮助我使用可以执行此过程的代码吗？为了在我目前的工作簿中进一步解释，salesmen 1有5个工作表，其名称在M4中，Salesmen 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

VBA将工作簿拆分为基于单元格值的多个工作簿

1 个答案: