Фильтрация столбца на основе значения и копирование значения из соответствующего значения

Question

Это скриншот моего документа Excel.

Я хочу применить фильтры на основе значений: Bimbo Mexico, Bimbo Canada, скопировать и вставить значения (из столбца 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