Копирайте клетка на един лист и я поставете на друг 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

End Sub


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