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搜索标题，复制并粘贴标题下的所有数据

回答

相关问题