Исправить макрос копирования значения ячейки с листа на лист

Sub Analitikmini() 'ÏÁÊ
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim sh1$, sh2$, sh3$, podr1$, podr2$, podr3$, arr1, arr3, sss, arr2, Fs, err_sh, strShErr$, err_str$
Dim Lr1&, Lr2&, Lr3&, mon1&, mon2&, mon3&, i&, j&, s As Double
Dim Dict1 As Object, Dict2 As Object, Dict3 As Object
Set Dict1 = CreateObject("Scripting.Dictionary")
Set Dict2 = CreateObject("Scripting.Dictionary")
Set Dict3 = CreateObject("Scripting.Dictionary")
With Sheets("ÏÁÊ")
    sh1 = .[m9].Value: sh2 = .[p9].Value: sh3 = .[s9].Value
    podr1 = .[k8].Value: podr2 = .[n8].Value: podr3 = .[q8].Value
    mon1 = .[m5].Value: mon2 = .[p5].Value: mon3 = .[s5].Value
    Fs = Range("b1:b" & .Cells(.Rows.Count, 2).End(xlUp).Row).Value
End With
On Error GoTo err_sh
strShErr = sh1
With Sheets(sh1)
    Lr1 = .Cells(.Rows.Count, 2).End(xlUp).Row
    arr1 = .Range("a6:p" & Lr1).Value
    For i = 1 To UBound(arr1)
        If arr1(i, 2) = podr1 Then
            For j = 5 To mon1 + 4
             s = s + arr1(i, j)
            Next
            Dict1.Add arr1(i, 2) & arr1(i, 4), CDbl(arr1(i, mon1 + 4)) & "|" & s
            s = 0
         End If
    Next
End With
strShErr = sh2
With Sheets(sh2)
    Lr2 = .Cells(.Rows.Count, 2).End(xlUp).Row
    arr2 = .Range("a6:p" & Lr2).Value
     For i = 1 To UBound(arr2)
        If arr2(i, 2) = podr2 Then
            For j = 5 To mon2 + 4
             s = s + arr2(i, j)
            Next
            Dict2.Add arr2(i, 2) & arr2(i, 4), CDbl(arr2(i, mon2 + 4)) & "|" & s
            s = 0
         End If
    Next
End With
strShErr = sh3
With Sheets(sh3)
    Lr3 = .Cells(.Rows.Count, 2).End(xlUp).Row
    arr3 = .Range("a6:p" & Lr3).Value
     For i = 1 To UBound(arr3)
        If arr3(i, 2) = podr3 Then
            For j = 5 To mon3 + 4
             s = s + arr3(i, j)
            Next
            Dict3.Add arr3(i, 2) & arr3(i, 4), CDbl(arr3(i, mon3 + 4)) & "|" & s
            s = 0
         End If
    Next
End With
On Error Resume Next
With Sheets("ÏÁÊ")
    For i = 13 To UBound(Fs)
     If Len(Fs(i, 1)) > 0 Then
     sss = Split(Dict1.Item(podr1 & Fs(i, 1)), "|")
     .Range("k" & i) = CDbl(sss(0)) / 1000
     .Range("l" & i) = CDbl(sss(1)) / 1000
     sss = Split(Dict2.Item(podr2 & Fs(i, 1)), "|")
     .Range("n" & i) = CDbl(sss(0)) / 1000
     .Range("o" & i) = CDbl(sss(1)) / 1000
       sss = Split(Dict3.Item(podr3 & Fs(i, 1)), "|")
     .Range("q" & i) = CDbl(sss(0)) / 1000
     .Range("r" & i) = CDbl(sss(1)) / 1000
     End If
    Next
End With
Application.ScreenUpdating = -1
Application.Calculation = xlAutomatic
Exit Sub
err_sh:
If Err.Number = 9 Then err_str = "Âûáåðèòå äðóãîé ïåðèîä" & strShErr
MsgBox "ÂÍÈÌÀÍÈÅ!" & vbCrLf & "Äàííûå çà âûáðàííûé ïåðèîä îòñóòñòâóþò" & vbCrLf & err_str
Application.ScreenUpdating = -1
Application.Calculation = xlAutomatic
End Sub