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

Question

Я новичок в VBA, я использую Microsoft Office Excel 2007 и читаю форумы, но это кажется мне невозможным. У меня есть текущий код, который копирует лист и добавляет день к дате, а также копирует диапазон ячеек, содержащих важную информацию из листа, чтобы иметь возможность вставить ее в календарь с информацией в реальном времени, и мне нужно, чтобы он вставлял туда, где дата такая же, и на одну ячейку ниже значения, которое может находиться в любом месте в определенном диапазоне.

Sub CopierPetete()
 ActiveWorkbook.ActiveSheet.Copy _
        After:=ActiveSheet
    'update date
        [J1].Value = [J1].Value + 1

   'THIS IS MY POOR ATTEMPT TO MAKE IT WORK
    If Sheets("Sheet5").Range("A1:K100").Value = ActiveSheet.Range("J1").Value Then _  

        ActiveSheet.Range("AA100:AC121").Select
            Selection.Copy
        Sheets("Sheet5").Select
            Sheets("Sheet5").Pictures.Paste Link:=True

    End If

End Sub

Мне нужно, чтобы оно совпадало со значением в ActiveAheet ячейке J1 с любой ячейкой на Sheet5 и вставлялось как Pictures.Paste Link=True (или, если у вас есть лучшая идея для способа отображения в реальном времени информация) в месте, где значение встречается на Sheet5, на одну ячейку ниже.

Вот ссылка на проект !

Answer 1

Если я хорошо понимаю, вы намереваетесь проверить, существует ли значение ячейки ActiveSheet> J1 на листе с именем "Sheet5" в диапазоне от A1 до K100 . То есть, если Excel находит ячейку с A1 по K100, соответствующую значению J1, скопируйте и вставьте изображение.

Вот попытка:

Sub CopierPetete()
    Dim rFind as Range

    ActiveWorkbook.ActiveSheet.Copy _
        After:=ActiveSheet
    'update date
        [J1].Value = [J1].Value + 1

    'Find returns a range object, so we use Set
    Set rFind = Worksheets("Sheet5").Range("A1:K100").Find(ActiveSheet.Range("J1").Value, LookIn:=xlValues, lookAt:=xlWhole)

    If Not rFind is Nothing Then
        ActiveSheet.Range("AA100:AC121").Copy
        Worksheets("Sheet5").Activate
        Worksheets("Sheet5").Range(rFind.Address).Offset(0, 1).Activate
        Worksheets("Sheet5").Pictures.Paste Link:=True
    End If
End Sub