Question

我需要构建一个基于M列（分销商）中的值创建新工作簿的宏。所以我会为每个经销商准备一份新工作簿。我试图在这里修改其他尝试类似但没有成功的人。提前谢谢。

以下是我试图获得类似结果的宏。不同之处在于我需要基于M列而不是B.另外，我的表单的名称是＆＃34; taxes_20150619-145507＆＃34;而不是Sheet1。我试图在代码中更改这些内容，但一直都会出错！

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

试试这个。

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

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

1 个答案: