根據值過濾列並從相應的值復制值

Question

這是我的excel文檔的屏幕截圖。

我想基於值應用過濾器：墨西哥Bimbo，加拿大Bimbo，然后將值（來自A和B列）復制並粘貼到新工作表中。 我要使用宏來執行此操作，因為我正在為客戶端構建模板。 有沒有辦法做到這一點？ 我知道可以手動使用過濾器來手動完成此操作，但我希望它基於宏

我想要這樣的輸出：

我使用了錄制宏，這是我得到的宏，

Sub RecordedMacro()
'

' RecordedMacro Macro
'

' Keyboard Shortcut: Ctrl+l
'
    Sheets("report").Select
    Range("C1").Select

    ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:="Barcel"
    Columns("L:L").Select

    Selection.Copy

    Sheets("SkuRounds").Select

    Columns("S:S").Select

    ActiveSheet.Paste
    Sheets("report").Select

    ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
        "Bimbo Canada"
    Columns("L:L").Select

    Application.CutCopyMode = False
    Selection.Copy
    Sheets("SkuRounds").Select
    Columns("T:T").Select
    ActiveSheet.Paste
    Sheets("report").Select
    ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
        "Bimbo Latin Centro"
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("SkuRounds").Select
    Columns("U:U").Select
    ActiveSheet.Paste
    Sheets("report").Select
    ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
        "Bimbo México"
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("SkuRounds").Select
    Columns("V:V").Select
    ActiveSheet.Paste
End Sub

我正在將數據從工作表（報告）復制到工作表（skurounds）

Answer 1

試試看：

Sub tgr()

    Dim wb As Workbook
    Dim wsReport As Worksheet
    Dim wsSKU As Worksheet
    Dim dictUnqCompanies As Object
    Dim aCompanies As Variant
    Dim vCompany As Variant
    Dim lDestCol As Long

    Set wb = ActiveWorkbook
    Set wsReport = wb.Sheets("report")
    Set wsSKU = wb.Sheets("skurounds")
    Set dictUnqCompanies = CreateObject("Scripting.Dictionary")
    lDestCol = wsSKU.Columns("S").Column

    'Clear previous results
    wsSKU.Range(wsSKU.Cells(1, "S"), wsSKU.Cells(1, wsSKU.Columns.Count)).EntireColumn.Clear

    With wsReport.Range("C2", wsReport.Cells(wsReport.Rows.Count, "C").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data
        If .Rows.Count = 1 Then
            'Only 1 row of data
            wsSKU.Cells(1, lDestCol).Value = .Value
            .Parent.Cells(.Row, "L").Copy wsSKU.Cells(2, lDestCol)
            Exit Sub
        Else
            aCompanies = .Value
        End If
    End With

    For Each vCompany In aCompanies
        If Not dictUnqCompanies.exists(vCompany) Then
            dictUnqCompanies.Add vCompany, vCompany
            With wsReport.Range("C1", wsReport.Cells(wsReport.Rows.Count, "C").End(xlUp))
                .AutoFilter 1, vCompany
                wsSKU.Cells(1, lDestCol).Value = vCompany
                Intersect(.Parent.Columns("L"), .Offset(1).EntireRow).Copy wsSKU.Cells(2, lDestCol)
                lDestCol = lDestCol + 1
                .AutoFilter
            End With
        End If
    Next vCompany

End Sub