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

根据值过滤列并从相应的值复制值

1 个答案: