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

Question

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

例如，在工作表 1 上

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

因此，宏将搜索"部分"，复制x，y和z(行数可以更改，所以我不能只说复制B2：B4(，并将其粘贴到工作表3的A2中。 然后，它将搜索价格，复制 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

谢谢！

Answer 1

像这样：

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