在每個工作表匹配的單元格上復制一個單元格並將其粘貼到另一個VBA

Question

我希望有人可以在這里幫助我。 我有以下代碼，在運行它時會返回錯誤消息。 我有一個報告，每小時都會導入Sheet2。 我需要在單元格D16中獲取值並將其復制。 然后，我需要將Sheet2！A2與Sheet3的第1行中的單元格匹配，並將數據粘貼到相應列下。

對於解決此問題的任何意見或建議，我將不勝感激。

提前致謝！

Sub CopyPaste()
Dim ws1 As Worksheet, ws2 As Worksheet, rng As Range, frng As Range

Set ws1 = Worksheets("Sheet2")
Set ws2 = Worksheets("Sheet3")
Set rng = ws1.Range("D16")
Set frng = ws2.Rows(1).Find(What:=Range("Sheet2!A2"), After:=Range("Sheet3!A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
         , SearchFormat:=False)

rng.Copy
frng.Offset(1, 0).PasteSpecial (xlPasteValues)
Application.CutCopyMode = 0

結束子

Answer 1

我會這樣做：

Sub CopyPaste()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim res

    Set ws1 = Worksheets("Sheet2")
    Set ws2 = Worksheets("Sheet3")

    res = Application.Match("*" & ws1.Range("A2") & "*", ws2.Range("1:1"), 0)

    If IsError(res) Then
        MsgBox "Nothing found"
        Exit Sub
    End If

    ws2.Cells(2, res).Value = ws1.Range("D16").Value
End Sub

要進行完全匹配，請使用res = Application.Match(ws1.Range("A2"), ws2.Range("1:1"), 0)