vba - 需要在这个宏中改变一点点

Question

我有这个宏，它完全符合我的要求，除了一个变化。我希望它按列“M”而不是“A”排序。我试过手动更改它，但我不断收到错误。我知道这可能是一个简单的修复，但我似乎无法得到它。提前致谢!

我试图将“字段:= 1”更改为字段:=“13”，但我得到“范围类的运行时错误'1004'自动过滤方法失败”。

调试然后突出显示“rngFilter.AutoFilter Field:=13, Criteria1:=cell.Value”

Private Sub CommandButton1_Click()


Dim wbDest As Workbook
Dim rngFilter As Range, rngUniques As Range
Dim cell As Range


Set rngFilter = Range("A1", Range("A" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False

With rngFilter


    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True


    Set rngUniques = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)


    ActiveSheet.ShowAllData

End With


For Each cell In rngUniques


    Set wbDest = Workbooks.Add(xlWBATWorksheet)


    rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value


    rngFilter.EntireRow.Copy
    With wbDest.Sheets(1).Range("A1")
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteValuesAndNumberFormats
    End With
    Application.CutCopyMode = True


    wbDest.Sheets(1).Name = cell.Value


    wbDest.SaveAs ThisWorkbook.Path & Application.PathSeparator & _
        cell.Value & " " & Format(Date, "mmm_dd_yyyy")

Next cell

rngFilter.Parent.AutoFilterMode = False
Application.ScreenUpdating = True

End Sub

Answer 1

试试这个。我已经更新了代码，因此您只需将 sColumn 从 A 更改为您想要的任何列字母:

Private Sub CommandButton1_Click()

    Const sColumn As String = "A"

    Dim wbDest As Workbook
    Dim rngFilter As Range, rngUniques As Range
    Dim cell As Range

    Set rngFilter = Range(sColumn & "1", Range(sColumn & Rows.Count).End(xlUp))

    Application.ScreenUpdating = False

    With rngFilter
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        Set rngUniques = Range(sColumn & "2", Range(sColumn & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End With


    For Each cell In rngUniques
        Set wbDest = Workbooks.Add(xlWBATWorksheet)
        rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value
        rngFilter.EntireRow.Copy
        With wbDest.Sheets(1).Range("A1")
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteValuesAndNumberFormats
        End With
        Application.CutCopyMode = True
        wbDest.Sheets(1).Name = cell.Value
        Application.DisplayAlerts = False
        wbDest.SaveAs ThisWorkbook.Path & Application.PathSeparator & cell.Value & " " & Format(Date, "mmm_dd_yyyy")
        wbDest.Close False
        Application.DisplayAlerts = True
    Next cell

    rngFilter.Parent.AutoFilterMode = False
    Application.ScreenUpdating = True

End Sub