Excel 过滤数据并将信息复制到新工作表

我有B18到AC列的代码列表

第13、15和17行始终为空，是标题的一部分

      B C   D   E   F   G   H
12  Codes   Desc    AP  TP  CP  DP  LP
13                          
14          TEP Q1  PR1 Q1 LT   LR1    
15                          
16  ABC xx  xx  xx  xx  xx  xx    
17                              
18  ab3 xx  xx  xx  xx  xx  xx
19  ab4 xx  xx  xx  xx  xx  xx
20  ab5 xx  xx  xx  xx  xx  xx
21  bd2 xx  xx  xx  xx  xx  xx
22  bd3 xx  xx  xx  xx  xx  xx
23  bd4 xx  xx  xx  xx  xx  xx
24  bd4 xx  xx  xx  xx  xx  xx
25  bd6 xx  xx  xx  xx  xx  xx
26  bd7 xx  xx  xx  xx  xx  xx
27  bd7 xx  xx  xx  xx  xx  xx
28  bd9 xx  xx  xx  xx  xx  xx

在单独的代码表中，我有一个用于查找的代码列表

Codes
ab3
bd4

我想过滤上面的代码，并将结果显示在新的工作表上：

    B   C   D   E   F   G
1   Codes   Desc    AP  TP  CP  DP  
2                           
3           TEP Q1  PR1 Q1 LT   LR1
4                           
5   ABC xx  xx  xx  xx  xx  xx
6                           
7   ab3 xx  xx  xx  xx  xx  xx
8   bd4 xx  xx  xx  xx  xx  xx
9   bd4 xx  xx  xx  xx  xx  xx

---

这样就行了。根据需要重命名图纸并重新定义范围

Option Explicit

Sub CopyRowsThatHaveTheRightCode()

    ' Assuming:
    ' Sheet1 is source sheet
    ' Sheet3 is destination sheet
    ' Codes are placed in Sheet2, starting at A2.

    Dim iSourceRow As Long
    Dim iDestinationRow As Long
    Dim iCode As Long
    Dim varCodes As Variant
    Dim booCopyThisRow As Boolean

    ' Copy headers (assuming you want this)
    Worksheets("Sheet1").Range("B12:AC16").Copy _
        Destination:=Worksheets("Sheet3").Range("B12:AC16")

    ' Get the pass codes
    varCodes = Worksheets("Sheet2").Range("A2").Resize(2, 1)
    ' Or wherever your codes are.

    ' Loop through all rows in source sheet
    iDestinationRow = 0
    For iSourceRow = 1 To 11 ' or however many rows you have
        booCopyThisRow = False
        For iCode = LBound(varCodes, 1) To UBound(varCodes, 1)
            If varCodes(iCode, 1) _
                = Worksheets("Sheet1").Range("B18").Cells(iSourceRow, 1) Then
                ' Code matches.
                booCopyThisRow = True
                Exit For
            End If
        Next iCode
        If booCopyThisRow = True Then
            ' Copy into next available destination row.
            iDestinationRow = iDestinationRow + 1
            Worksheets("Sheet1").Range("B18").Cells(iSourceRow, 1).Resize(1, 28).Copy _
                Destination:=Worksheets("Sheet3").Range("B18").Cells(iDestinationRow, 1)
        End If
    Next iSourceRow


End Sub

---

我想你必须给我们展示一个你想要实现的例子。现在我一点也不明白。再一次对此感到抱歉。但是我想在excel工作表中包含一个表格格式，但是格式又变差了，仍然很神秘。您只是想将a列中的值与“筛选器”列表中的值匹配的行复制到新工作表中吗？应该复制整行还是只复制A:AC列？另外，请将格式设置为

code

以获得固定宽度字体，并正确对齐列，否则阅读起来会很痛苦。我对格式感到非常抱歉。这是我能做的最好的了。A列中的值是隐藏的，我真的不需要它们。我需要所有的标题行从B12到AC17被复制到一个新的工作表连同过滤数据。因此，我希望宏在代码表中查找代码，并在原始表中过滤/查找这些代码的所有数据，然后与B12到AC17的听者一起复制并粘贴到新表上。希望它比以前更清楚。因此，重新表述您的问题：您想从工作表A提取一个新的工作表N。您想根据工作表A第[B]列中的标准选择行。您感兴趣的所有代码都列在代码表C中