過濾excel列并將粘貼復制到另一個新作業表，作業表名稱應為過濾值-有解無憂

我正在將過濾器應用于 column1 并將資料粘貼到新作業表我試圖添加帶有過濾器名稱的新作業表，例如：列 1 有 a、b、c 并且新作業表應該是 a、b、c。附上我試過的代碼。你能幫我解決這個問題嗎？提前致謝。

Sub filter()`enter code here`
    Application.ScreenUpdating = False
    Dim x As Range
    Dim rng As Range
    Dim last As Long
    Dim sht As String

    'specify sheet name in which the data is stored
    sht = "DATA Sheet"

    'change filter column in the following code
    last = Sheets(sht).Cells(Rows.Count, "F").End(xlUp).Row
    Set rng = Sheets(sht).Range("A1:F" & last)

    Sheets(sht).Range("F1:F" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True

    For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
    With rng
    .AutoFilter
    .AutoFilter field:=6, Criteria1:=x.Value
    .SpecialCells(xlCellTypeVisible).Copy
    i = x
    For i = 2 To last
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Range("a" & x).Value
    'Sheets.Add.Name = Range("a3").Value
    Next i
    ActiveSheet.Paste

    End With
    Next x

    ' Turn off filter
    Sheets(sht).AutoFilterMode = False

    With Application
    .CutCopyMode = False
    .ScreenUpdating = True
    End With

End Sub

uj5u.com熱心網友回復：

如果 A 列是名稱所在，則將過濾器放在 A 列上。

Option Explicit

Sub FilterToSheet()

    Dim rng As Range, rngCopy As Range, x, arNames
    Dim last As Long, sht As String, n As Long

    'specify sheet name in which the data is stored
    sht = "DATA Sheet"

    ' filter on column A
    With Sheets(sht)
        .AutoFilterMode = False
        
        last = .Cells(Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A1:F" & last)
        .Columns("AA:AA").Clear
        .Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, _
           CopyToRange:=.Range("AA1"), Unique:=True
        last = .Cells(Rows.Count, "AA").End(xlUp).Row
        
        ' list of filter names
        arNames = .Range("AA2:AA" & last).Value
        .Columns("AA:AA").Clear
    End With
    
    Application.ScreenUpdating = False
    
    ' aply filter for each name
    For Each x In arNames
        
        With rng
            .AutoFilter
            .AutoFilter field:=1, Criteria1:=x
            Set rngCopy = .SpecialCells(xlCellTypeVisible)
        End With
        
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = x
        rngCopy.Copy
        ActiveSheet.Paste
        ActiveSheet.Range("A1").Select
        n = n   1
        
    Next x

    ' Turn off filter
    Sheets(sht).AutoFilterMode = False
    Sheets(sht).Activate

    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    MsgBox n & " sheets created", vbInformation
End Sub

轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/396397.html

標籤：擅长 vba

上一篇：Excel搜索包含子字串的多行

下一篇：使用UnixUSFormattedDate-time-year在Excel中進行計算