Sub Скопировать()

    Dim sh1 As Worksheet, sh2 As Worksheet, arr2()
    Dim var, lr As Long, r As Long, c As Long, i As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set sh1 = Worksheets("Лист1")
    Set sh2 = Worksheets("Лист2")
    lr = sh2.Cells(sh2.Rows.Count, "O").End(xlUp).Row
    arr2() = sh2.Range("A1:I" & lr).Value
    
    For i = 2 To UBound(arr2)
        r = WorksheetFunction.Match(arr2(i, 4), sh1.Columns("B"), 0)
        var = CDate(arr2(i, 9)) + sh1.Cells(r, "C").Value
        var = CLng(var)
        c = WorksheetFunction.Match(var, sh1.Rows(1), 0)
        sh2.Cells(i, "O").Copy
        sh1.Cells(r, c).PasteSpecial xlPasteValues
        sh1.Cells(r, c).PasteSpecial xlPasteComments
    Next i
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Готово!", vbInformation

End Sub