Question

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

例如，在工作表1上

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

因此，宏会搜索＆＃34; Part＆＃34;，复制x，y和z（行数可以改变，所以我只能说复制B2：B4），并将其粘贴到A3中第2页。然后，它将搜索价格，复制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

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

1 个答案: