Range("A5").AutoFill Destination:=Range("Лист1!A5:A" & iLastRow), Type:=xlFillDefault

Sub insert_formulas()
'
' insert_formulas Макрос
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=Таблица_база_Лист3[@[это база]]"
    Range("A5").Select
    Selection.AutoFill Destination:=Range("A5:A1330"), Type:=xlFillDefault
    Range("A5:A1330").Select
End Sub

Sub search_free_cell() ' поиск своб ячейки
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(iLastRow + 1, 1).Select
End Sub1

 Selection.AutoFill Destination:=Range("A5:A1330"), Type:=xlFillDefault
    Range("A5:A1330").Select

Sub in_actualize_stocs()
    Dim arrTmp, i As Long, wb As Workbook, wsh As Worksheet, lLastRow As Long, _
        rngShop As Range, arrShop, dictShop As Object, _
        rngStorage As Range, arrStorage, dictStorage As Object
' - тут объявляем имена листов
    Const sSTORAGE_NAME_WSH As String = "продано"
    Const sSHOP_NAME_WSH As String = "магазин"
      
    Set wb = ActiveWorkbook
      
' - проверили наличие листов склад, приход
    arrTmp = Array(sSTORAGE_NAME_WSH, sSHOP_NAME_WSH)
    With wb
        On Error Resume Next
        For i = LBound(arrTmp, 1) To UBound(arrTmp, 1)
            Set wsh = .Sheets(arrTmp(i))
            If wsh Is Nothing Then
                MsgBox "Ключевой лист """ & arrTmp(i) & """" & Chr(10) & _
                    "отсутствует в книге """ & .Name & """." & Chr(10) & _
                    "Макрос прерывает свою работу.", vbCritical
                Exit Sub
            End If
        Next i
        On Error GoTo 0
  
' - считать продажи приход. в массив (ш/к, продано)
        With .Sheets(sSHOP_NAME_WSH)
            lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Range("A2").Row > lLastRow Then
                MsgBox "Продаж в приходе не обнаружено." & Chr(10) & _
                    "Макрос прерывает свою работу.", vbCritical
                Exit Sub
            End If
            Set rngShop = .Range("A2:D" & lLastRow)
        End With ' .Sheets(sSHOP_NAME_WSH)
        Set dictShop = CreateObject("scripting.dictionary")
        arrShop = rngShop.Value
' - собрали словарь с массива прихода (ключ: ш/к; значение: кол-во продаж)
        For i = 1 To UBound(arrShop, 1)
            If dictShop.exists(arrShop(i, 1)) Then
                dictShop(arrShop(i, 1)) = dictShop(arrShop(i, 1)) + arrShop(i, 4)
            Else
                dictShop(arrShop(i, 1)) = arrShop(i, 4)
            End If
            arrShop(i, 4) = Empty
        Next i
          
' - считать продажи склада в массив (ш/к, кол-во)
        With .Sheets(sSTORAGE_NAME_WSH)
            lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Range("A5").Row > lLastRow Then
                MsgBox "Остатков на складе не обнаружено." & Chr(10) & _
                    "Макрос прерывает свою работу.", vbCritical
                Exit Sub
            End If
            Set rngStorage = .Range("A5:C" & lLastRow)
        End With ' .Sheets(sSTORAGE_NAME_WSH)
        Set dictStorage = CreateObject("scripting.dictionary")
        arrStorage = rngStorage.Value
' - собрали словарь со склада (ключ: ш/к; значение: любое)
        For i = 1 To UBound(arrStorage, 1)
' - если есть дубли по ш/к на складе - прервать макрос
            If dictStorage.exists(arrStorage(i, 1)) Then
                MsgBox "На складе обнаружено дублирование по ш/к """ & arrStorage(i, 1) & """." & Chr(10) & _
                    "Макрос прерывает свою работу.", vbCritical
                Exit Sub
            Else
                dictStorage(arrStorage(i, 1)) = arrStorage(i, 3)
            End If
            If dictShop.exists(arrStorage(i, 1)) Then
' - от остатка отняли продажи (или прибавили - на +)
                arrStorage(i, 3) = arrStorage(i, 3) + dictShop(arrStorage(i, 1))
' - отнятые продажи удалили из словаря маг.
                dictShop.Remove (arrStorage(i, 1))
            End If
        Next i
    End With ' wb
' - массив маг. на соотв. лист
    rngShop.Value = arrShop
' - массив склада на соотв. лист
    rngStorage.Value = arrStorage
' - если после цикла в словаре маг. что-то осталось, то сообщить об этом
    If dictShop.Count > 0 Then
        MsgBox "приходом были проданы товары, которых нет на складе!", vbCritical
    Else
        MsgBox "Work complete!", vbInformation
    End If
' - тут вызываем макрос из модуля 4
    Call clear
     
End Sub

' - массив маг. на соотв. лист
    rngShop.Value = arrShop
' - массив склада на соотв. лист
    rngStorage.Value = arrStorage

    rngShop.Value = arrShop
    rngStorage.Value = arrStorage

Sub in_actualize_stocs()
    Dim arrTmp, i As Long, wb As Workbook, wsh As Worksheet, lLastRow As Long, _
        rngShop As Range, arrShop, dictShop As Object, _
        rngStorage As Range, arrStorage, dictStorage As Object

    Const sSTORAGE_NAME_WSh As String = "продано"
    Const sSHOP_NAME_WSh As String = "магазин"
     
    Set wb = ActiveWorkbook

    arrTmp = Array(sSTORAGE_NAME_WSh, sSHOP_NAME_WSh)
    With wb
        On Error Resume Next
        For i = LBound(arrTmp, 1) To UBound(arrTmp, 1)
            Set wsh = .Sheets(arrTmp(i))
            If wsh Is Nothing Then
                MsgBox "111""" & arrTmp(i) & """" & Chr(10) & _
                    "111 """ & .Name & """." & Chr(10) & _
                    "111.", vbCritical
                Exit Sub
            End If
        Next i
        On Error GoTo 0
 
        With .Sheets(sSHOP_NAME_WSh)
            lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Range("A2").Row > lLastRow Then
                MsgBox "111." & Chr(10) & _
                    "111.", vbCritical
                Exit Sub
            End If
            Set rngShop = .Range("A2:D" & lLastRow)
        End With ' .Sheets(sSHOP_NAME_WSh)
        Set dictShop = CreateObject("scripting.dictionary")
        arrShop = rngShop.Value

        For i = 1 To UBound(arrShop, 1)
            If dictShop.exists(arrShop(i, 1)) Then
                dictShop(arrShop(i, 1)) = dictShop(arrShop(i, 1)) + arrShop(i, 4)
            Else
                dictShop(arrShop(i, 1)) = arrShop(i, 4)
            End If
            arrShop(i, 4) = Empty
        Next i     

        With .Sheets(sSTORAGE_NAME_WSh)
            lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Range("A5").Row > lLastRow Then
                MsgBox "111." & Chr(10) & _
                    "111.", vbCritical
                Exit Sub
            End If
            Set rngStorage = .Range("A5:C" & lLastRow)
        End With ' .Sheets(sSTORAGE_NAME_WSh)
        Set dictStorage = CreateObject("scripting.dictionary")
        arrStorage = rngStorage.Value

        For i = 1 To UBound(arrStorage, 1)

            If dictStorage.exists(arrStorage(i, 1)) Then
                MsgBox "111""" & arrStorage(i, 1) & """." & Chr(10) & _
                    "111.", vbCritical
                Exit Sub
            Else
                dictStorage(arrStorage(i, 1)) = arrStorage(i, 3)
            End If
            If dictShop.exists(arrStorage(i, 1)) Then

                arrStorage(i, 3) = arrStorage(i, 3) + dictShop(arrStorage(i, 1))

                dictShop.Remove (arrStorage(i, 1))
            End If
        Next i
    End With ' wb

    rngShop.Value = arrShop
    rngStorage.Value = arrStorage

    If dictShop.Count > 0 Then
        MsgBox "111", vbCritical
    Else
        MsgBox "Work complete!", vbInformation
    End If

    Call clear    
End Sub

End If
    Call clear
    Sub clear()
Range("A5:A500,D5:D500,M4").Select
Range("A5").Activate
Selection.ClearContents
End Sub

Sub clear()
    Range("A5:A500,D5:D500,M4").Select
    Range("A5").Activate
    Selection.ClearContents