根据主参考列表VBA将内容从一张纸复制到另一张纸

Question

我正在尝试格式化报告并将重要值复制到一张空白纸上。

我正在使用参考主列表来决定哪些信息重要或不重要。每个项目的唯一引用存储在 B 列中名为“主列表”的工作表中，我希望我的宏扫描此列表并查看它是否可以在“原始数据”工作表中找到匹配项并将匹配的行复制到“报告”表。

我所做的尝试可以很好地完成所有初始格式设置，但是当它遇到第一个 While 命令时会绊倒。我已经尝试了几种不同的方法来做到这一点，但我似乎无法让它发挥作用。用莱娅公主的话来说，帮助我 Stack Overflow 你是我唯一的希望

Dim RD As Worksheet, Report As Worksheet, Masterlist As Worksheet
Dim LSearchRow As Integer
Dim LCopytoRow As Integer
Dim rngFound As Range
Dim SearchItem As String


Set RD = Sheets("Raw Data")
Set Report = Sheets("Report")
Set Masterlist = Sheets("Master List")


LCopytoRow = 1
LSearchRow = 1

RD.Select
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft

    Columns("B:D").Select
    Selection.Delete Shift:=xlToLeft

    Columns("D:Q").Select
    Selection.Delete Shift:=xlToLeft

    Columns("E:I").Select
    Selection.Delete Shift:=xlToLeft

    Columns("C:C").Select
    Selection.ClearContents


While Len(Range("A" * CStr(LSearchRow)).Value) > 0
    SearchItem = Masterlist.Range("B" & k).End(xlUp).Row
    If Range("A" & CStr(LSearchRow)).Value = Masterlist.Range("B" & CStr(LSearchRow)).Value Then
        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Cut

        Report.Select
        Rows(CStr(LCopytoRow) & ":" & CStr(LCopytoRow)).Select
        ActiveSheet.Paste

        LCopytoRow = LCopytoRow + 1

        RD.Select
    End If

    LSearchRow = LSearchRow + 1

Wend

提前致谢！

Answer 1

没有样本数据很难测试，但这样的东西应该适合你：

Sub tgr()

    Dim wb As Workbook
    Dim wsMstr As Worksheet
    Dim wsData As Worksheet
    Dim wsRprt As Worksheet
    Dim aMasterFilter As Variant

    Set wb = ActiveWorkbook
    Set wsMstr = wb.Sheets("Master List")
    Set wsData = wb.Sheets("Raw Data")
    Set wsRprt = wb.Sheets("Report")

    wsData.Range("A:A,C:E,H:U,W:AA").EntireColumn.Delete xlToLeft
    wsData.Columns("C").EntireColumn.ClearContents
    wsData.AutoFilterMode = False

    aMasterFilter = Application.Transpose(wsMstr.Range("B1", wsMstr.Cells(wsMstr.Rows.Count, "B").End(xlUp)).Value)
    With wsData.Range("A1", wsData.Cells(wsData.Rows.Count, "A").End(xlUp))
        .AutoFilter 1, aMasterFilter, xlFilterValues
        .EntireRow.Copy wsRprt.Range("A1")
        .EntireRow.Delete xlShiftUp
        .Parent.AutoFilterMode = False
    End With

End Sub