通过M列中的值创建新工作簿的宏

Question

I need to build a Macro that creates new workbooks based on the values in Column M (distributors). So I would have a new workbook for each distributor. I've tried modifying others on here that were attempting something similar with no success. Thanks in advance.

Here is the macro that I'm trying to get similar results from. The differences are that I need mine based off of column M instead of B. Also, my sheet's name is "taxes_20150619-145507", not Sheet1. I've tried to change these in the code but keep getting errors!

Sub details()

Dim thisWB  As String

Dim newWB As String

thisWB = ActiveWorkbook.Name

On Error Resume Next
Sheets("tempsheet").Delete
On Error GoTo 0

Sheets.Add
ActiveSheet.Name = "tempsheet"

Sheets("Sheet1").Select

If ActiveSheet.AutoFilterMode Then
    Cells.Select

    On Error Resume Next

    ActiveSheet.ShowAllData

    On Error GoTo 0

End If

Columns("B:B").Select
Selection.Copy

Sheets("tempsheet").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

If (Cells(1, 1) = "") Then
    lastrow = Cells(1, 1).End(xlDown).Row

    If lastrow <> Rows.Count Then
        Range("A1:A" & lastrow - 1).Select
        Selection.Delete Shift:=xlUp
    End If

End If

Columns("A:A").Select
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=Range("B1"), Unique:=True

Columns("A:A").Delete

Cells.Select
Selection.Sort _
        Key1:=Range("A2"), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row

For suppno = 2 To lMaxSupp

    Windows(thisWB).Activate

    supName = Sheets("tempsheet").Range("A" & suppno)

    If supName <> "" Then

        Workbooks.Add
        ActiveWorkbook.SaveAs supName
        newWB = ActiveWorkbook.Name

        Windows(thisWB).Activate

        Sheets("Sheet1").Select
        Cells.Select

        If ActiveSheet.AutoFilterMode = False Then
            Selection.AutoFilter
        End If

        Selection.AutoFilter Field:=2, Criteria1:="=" & supName, _
                    Operator:=xlAnd, Criteria2:="<>"

        lastrow = Cells(Rows.Count, 2).End(xlUp).Row

        Rows("1:" & lastrow).Copy

        Windows(newWB).Activate
        ActiveSheet.Paste

        ActiveWorkbook.Save
        ActiveWorkbook.Close

    End If

Next

Sheets("tempsheet").Delete

Sheets("Sheet1").Select
If ActiveSheet.AutoFilterMode Then
    Cells.Select
    ActiveSheet.ShowAllData
End If

End Sub

Answer 1

Try this.

Sub AddNew()
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs fileName:="Allsales.xls" 'Replace with the column M's value
    End With
End Sub