VBAヘッダーの下にあるすべてのデータをヘッダー、コピー、およびペーストします。

Question

列ヘッダー名を検索し、その列を見つけてその下のすべてのデータをコピーし、別のセル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 

Thaあなた！このような

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