VBA搜索標題，複製並粘貼標題下的所有數據

我需要創建一個宏來搜索列標題名稱，找到列，複製下面的所有數據，然後將它粘貼到另一個單元格A3中工作表。VBA搜索標題，複製並粘貼標題下的所有數據

例如，在表1

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

因此，宏將搜索「部分」，複製的x，y和z（行數可以改變，所以我不能只是說副本B2 ：B4），然後粘貼到Sheet 2的A3中。然後，它會搜索價格，複製5,6和7，並將其粘貼到Sheet 2的B3中。etc etc

這是我所擁有的到目前爲止：

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你好！

來源

2017-08-14 Chim Richalds

你做了什麼到現在？嘗試尋找.Find函數並從這個範圍的.Adress或者.Column複製作爲參考文獻 – danieltakeshi

首先查看'Find（）' - 當你有一些代碼時回發。 –

或者，如果您知道excel函數MATCH的工作原理，請在VBA中查找，如果知道列號，也可以google如何獲取最後一行。 – jamheadart

事情是這樣的：

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

來源

2017-08-14 22:51:10

Tim，這幾乎就是我正在尋找的東西！但是，是否可以僅複製「標題」列下面的數據？我的「複製來自」工作表中的標題並不完全如何我想要在「粘貼到工作表」上寫的標題，所以我只需要標題下方的信息。對不起，這個東西挺新的。謝謝！ –

看我上面的編輯 –

VBA搜索標題，複製並粘貼標題下的所有數據

回答

相關問題