Скопируйте ячейку на один лист и вставьте ее на другой VBA на основе ячейки из каждого сопоставленного листа

Я надеюсь, что здесь мне кто-нибудь поможет. У меня есть приведенный ниже код, который возвращает сообщение об ошибке при запуске. У меня есть отчет, который я каждый час импортирую в Sheet2. Мне нужно взять значение в ячейке D16 и скопировать его. Затем мне нужно сопоставить Sheet2! A2 с ячейкой в ​​строке 1 на Sheet3 и вставить данные в соответствующий столбец.

Буду признателен за любой вклад или предложения по решению этой проблемы.

Заранее спасибо!

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

Конец подписки


excel copy-paste vba
person user3259277    schedule 12.03.2014    source источник
comment
измените Range("Sheet2!A2") на ws1.Range("A2") и удалите After:=Range("Sheet3!A1"),   -  person Dmitry Pavliv    schedule 13.03.2014
comment
Я только что попробовал ваше предложение, но все еще получаю сообщение об ошибке. Это ошибка времени выполнения «91»: переменная объекта или переменная блока не установлена ​​и выделяет frng.Offset (1,0) .PasteSpecial (xlPasteValues).   -  person user3259277    schedule 13.03.2014
comment
Это потому, что ничего не нашел. Вы также должны добавить чек: If frng Is Nothing Then Exit Sub   -  person Dmitry Pavliv    schedule 13.03.2014
comment
Спасибо, Симоко! Я очень ценю это!   -  person user3259277    schedule 13.03.2014

Ответы (1)


arrow_upward
0
arrow_downward

Я бы сделал это:

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)

person Dmitry Pavliv    schedule 12.03.2014