Hello,

my main sub is looking like that:

Sub download_zlicz()

Dim PathFiles As String
Dim Variable As Integer
Dim Array_Paths As Variant
Dim i As Integer
Dim wbworkbook As Workbook
Dim dictionar As Object

Set dictionar = CreateObject("Scripting.dictionary")

Variable = 3

Array_Paths = MsoFilePicker("Wybierz pliki", PathFiles, Variable)

    For i = 1 To UBound(Array_Paths)
        Set wbworkbook = Workbooks.Open(Array_Paths(i))
        Call WorkBooks_Looping(dictionar)
    Next i

End Sub
In bold code there is reference to function:

Function WorkBooks_Looping(dictionar)

Dim wbMain As Workbook
Dim wsCount As Integer
Set wbMain = ActiveWorkbook
Dim wbworkbook As Worksheet
Dim y As Long
Dim i As Long
Dim ArrayLoop As Variant
Dim Dict_People As Object
Dim coll As New Collection
Dim Dictionary_Child As Object
Dim varArray As Variant
Dim Wylicz As String
Dim z As Long
Dim Count_Dict As Long
Dim Dict_Temp As Object

Set Dictionary_Child = CreateObject("Scripting.dictionary")
wsCount = wbMain.Worksheets.Count

Set wbworkbook = ActiveSheet

For i = 1 To wsCount
If wbMain.Worksheets(i).Name Like "20*" Then

Set wbworkbook = ActiveSheet

Set Dict_People = CreateObject("Scripting.dictionary")
ArrayLoop = wbworkbook.Range(Cells(2, 5), Cells(154, 10))

For y = 1 To UBound(ArrayLoop)

    If Len(ArrayLoop(y, 3)) > 1 Then

        If Not Dict_People.Exists(ArrayLoop(y, 3)) Then
        
            Dictionary_Child.Add ArrayLoop(y, 3), Nothing
            Dictionary_Child.Add ArrayLoop(y, 1), Nothing
            Dictionary_Child.Add ArrayLoop(y, 2), Nothing
            Dictionary_Child.Add ArrayLoop(y, 6), Nothing
            Dict_People.Add ArrayLoop(y, 3), Dictionary_Child
            
            Dim vitems, vkeys As Variant
            
            Set Dictionary_Child = Nothing
            Set Dictionary_Child = CreateObject("Scripting.dictionary")
            
            vkeys = Dict_People.Keys
            vitems = Dict_People.items
        Else
            
            Set Dict_Temp = CreateObject("Scripting.dictionary")
            
            Dict_Temp.Add ArrayLoop(y, 3), Nothing
            
            On Error Resume Next
            Dict_Temp.item(ArrayLoop(y, 3)) = Dict_People(ArrayLoop(y, 3)).Keys
            
            vkeys = Dict_Temp.Keys
            vitems = Dict_Temp.items
            varArray = Application.Index(Dict_Temp.items, 0, 0)
            varArray(4) = ArrayLoop(y, 6) + varArray(4)
            Dict_People.item(ArrayLoop(y, 3)) = varArray
            
            vkeys = Dict_People.Keys
            vitems = Dict_People.items
            
            Set Dict_Temp = Nothing
            
        End If
        
    End If

Next y

End If
Next i

WorkBooks_Looping = Dict_People

End Function
So after different countings I have dictionary Dict_People and i want to pass it into my main sub.

Now function WorkBooks_Looping will be empty.

How can i do this?

Please help,
Best Wishes,
Jacek Antek