如何使用vba查找和复制特定列

Question

你能帮我吗？我需要excel从sheet1中找到列“商品”并将其复制到sheet3中并与sheet2一样。我需要将数据复制到一个A列中的一个sheet3（一个接一个）。但在复制只是交换数据时低于代码。我只有sheet3中的sheet2数据

Sheets("sheet1").Select
desc = WorksheetFunction.Match("goods", Rows("1:1"), 0)
cst = WorksheetFunction.Match("goods", Rows("1:1"), 0)
Sheets("sheet1").Columns(desc).CopyDestination:=Sheets("sheet3").Range("A:A)
Sheets("sheet2").Columns(cst).CopyDestination:=Sheets("sheet3").Range("A:A")

感谢您的回答

Answer 1

我更喜欢使用Range().Find而不是WorksheetFunction.Match。主要是因为您不必使用Range().Find输入您的查找值（例如WorksheetFunction.Match("1234", Rows("1:1"), 0)不起作用。

在这里，我使用它作为查找范围起点的便捷方式。

Sub CopyGoods()

    Dim goods As Range

    Set goods = Sheets("sheet1").Rows(1).Find("goods")

    If goods Is Nothing Then

        MsgBox "Goods does not exists on Sheet1", vbInformation, "Goods not found"

    Else

        goods.EntireColumn.Copy Sheets("sheet3").Range("A1")

    End If

    Set goods = Sheets("sheet2").Rows(1).Find("goods")

    If goods Is Nothing Then

        MsgBox "Goods does not exists on Sheet2", vbInformation, "Goods not found"

    Else

        Set goods = Range(goods.Offset(1), goods.Offset(Rows.Count - 1).End(xlUp))
        goods.Copy Destination:=Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)

    End If

End Sub