Ошибка выполнения '1004' Определенная приложением или объектная ошибка

Question

Я получаю ошибку «Runtime error» 1004 «Определенная приложением или объектная» ошибка, когда я пытаюсь запустить код ниже. Старался исправить это сейчас на пару часов, но, похоже, не может быть прав.

Что я пытаюсь сделать: два листа, один с проектами и другие со всеми перками, связанными с каждым Проектом. Таким образом, на листе Perks может быть несколько строк с одним и тем же project_id, тогда как на листе Project все объекты project_id уникальны. Я хочу получить ряд данных о строках с одним и тем же project_id на листе Perks, который будет размещен рядом друг с другом в одной строке того же project_id на странице «Проекты». Надеюсь, вы все еще следуете тому, что я имею в виду;). Код, который я использую ниже, отлично работает в других книгах с подобными ситуациями, поэтому не уверен, что проблема здесь. На листе Perks имеется около 3000 записей, поэтому я не думаю, что это не проблема. Есть предположения?

Sub Perks_and_Projects() 
    Dim r As Long, lr As Long 
    Dim src As Object 
    Application.ScreenUpdating = False 
    With Sheets("Perks") 
     lr = .Cells(Rows.Count, 1).End(xlUp).Row 

     For r = 2 To lr 
     Set src = Sheets("Projects").Columns(1).Find(.Cells(r, 1).Value, LookAt:=xlWhole) 
     If Not src Is Nothing Then 
*'error occurs on the next line:*   
     Sheets("Projects").Range("AA" & src.Row).End(xlToRight).Offset(0, 1).Value = .Cells(r, 19).Value 
     Sheets("Projects").Range("AA" & src.Row).End(xlToRight).Offset(0, 1).Value = .Cells(r, 20).Value 
     Sheets("Projects").Range("AA" & src.Row).End(xlToRight).Offset(0, 1).Value = .Cells(r, 21).Value 
     Sheets("Projects").Range("AA" & src.Row).End(xlToRight).Offset(0, 1).Value = .Cells(r, 22).Value 
     Sheets("Projects").Range("AA" & src.Row).End(xlToRight).Offset(0, 1).Value = .Cells(r, 23).Value 
     Sheets("Projects").Range("AA" & src.Row).End(xlToRight).Offset(0, 1).Value = .Cells(r, 24).Value 
     End If 
     Next r 
    End With 
    Application.ScreenUpdating = True 

    End Sub 

Answer 1

Мне наконец-то удалось создать обходное решение. Вот код, если кто-то сталкивается с аналогичной ситуацией:

Sub Perks_and_Projects() 
Dim b As Variant, r As Long, lr As Long, n As Long 
Dim src As Object, d As Integer 
Application.ScreenUpdating = False 
With Sheets("Perks") 
    lr = .Cells(Rows.Count, 1).End(xlUp).Row 
    b = .Range("A1:B" & lr) 
    For r = 1 To lr 
     Set src = Sheets("Projects").Columns(1).Find(.Cells(r, 1).Value, LookAt:=xlWhole) 
     d = Sheets("Projects").Cells(src.Row, .Columns.Count).End(xlToLeft).Column 
     If Not src Is Nothing Then 
     Sheets("Projects").Cells(src.Row, d).Offset(0, 1).Value = .Cells(r, 19).Value 
     Sheets("Projects").Cells(src.Row, d).Offset(0, 2).Value = .Cells(r, 20).Value 
     Sheets("Projects").Cells(src.Row, d).Offset(0, 3).Value = .Cells(r, 21).Value 
     Sheets("Projects").Cells(src.Row, d).Offset(0, 4).Value = .Cells(r, 22).Value 
     Sheets("Projects").Cells(src.Row, d).Offset(0, 5).Value = .Cells(r, 23).Value 
     Sheets("Projects").Cells(src.Row, d).Offset(0, 6).Value = .Cells(r, 23).Value 
    End If 
    Next r 
End With 
Sheets("Perks").Range("A1").Resize(UBound(b, 1), UBound(b, 2)) = b 
Application.ScreenUpdating = True 

End Sub