Excel VBA搜索标题，复制并粘贴标题下的所有数据

我需要创建一个宏来搜索列标题名称，找到列，复制列下面的所有数据，然后将其粘贴到另一个工作表的单元格A3中

例如，在第1页上

+-----+------+-------+
| Row | Part | Price |
+-----+------+-------+
|   1 | X    |     5 |
|   2 | y    |     6 |
|   3 | Z    |     7 |
+-----+------+-------+

因此，宏将搜索“部分”，复制x、y和z（行数可以更改，所以我不能只说复制B2:B4），并将其粘贴到第2页的A3中。 然后，它将搜索价格，复制5、6和7，并将其粘贴到第2页的B3中。等等

以下是我到目前为止的情况：

Sub Cleanup() 
    Sheets("Sheet1").Select 
    PN = WorksheetFunction.Match("PART_NO", Rows("1:1"), 0) 
    Sheets("Sheet1").Columns(PN).Copy _
              Destination:=Sheets("Sheet2").Range("A3") 
End Sub

谢谢大家!

类似这样：

Sub Cleanup()

    Dim arrCols, shtSrc As Worksheet, rngDest As Range, hdr, pn

    arrCols = Array("PART_NO", "QTY", "UNITS") '<< column headers to be copied

    Set shtSrc = Sheets("Sheet1")              '<< sheet to copy from
    Set rngDest = Sheets("Sheet2").Range("A3") '<< starting point for pasting

    'loop over columns
    For Each hdr In arrCols

        pn = Application.Match(hdr, shtSrc.Rows(1), 0)

        If Not IsError(pn) Then
            '##Edit here##
            shtSrc.Range(shtSrc.Cells(2, pn), _
                         shtSrc.Cells(Rows.Count, pn).End(xlUp)).Copy rngDest
            '/edit
        Else
            rngDest.Value = hdr
            rngDest.Interior.Color = vbRed '<< flag missing column
        End If

        Set rngDest = rngDest.Offset(0, 1)
    Next hdr

End Sub

Sub-Cleanup（）
尺寸arrCols、shtSrc As工作表、rngDest As范围、hdr、pn
arrCols=Array（“零件号”、“数量”、“单位”）“到目前为止，您都做了些什么？尝试查找.Find函数并从该范围的.address或作为引用的.Column中复制。当您有一些代码时，请查看
Find（）
-post back。或者，如果您知道excel函数匹配的工作原理，请在VBA中查找该函数，此外，如果您知道列号，还可以通过谷歌搜索如何获取最后一行。以下是我目前掌握的信息：Sub Cleanup（）Sheets（“Sheet1”）。选择PN=WorksheetFunction.Match（“PART_NO”），Rows（“1:1”），0）Sheet1。Columns（PN）。复制目标：=Sheets（“Sheet2”）。Range（“A3”）End Sub当它尝试粘贴到A3中时失败（复制和粘贴区域大小不一样）。我理解它失败的原因，但我不知道如何只复制列中包含数据的行，而不是整个列。蒂姆，这几乎正是我要寻找的！但是，是否可以只复制“header”列下的数据？复制自中的头“工作表不是我想要的“粘贴到工作表”上的标题，所以我只需要标题下的信息。对不起，这是新的东西。谢谢！