Sub StartFromButton()
    UserForm1.Show
End Sub

Sub main()
Application.ScreenUpdating = False

Dim wSheet As Worksheet
Dim ID, Articul, Name, Group, PodGroup, Production As String
Dim Quantity As Integer
Dim Fact, Zakup As Double

Dim c As Range
Dim Month As String
Dim mainBook, dataBook As String
Dim monthNum As Long

mainBook = ActiveWorkbook.Name
Workbooks.Open (UserForm1.TextBox1.Value)
dataBook = ActiveWorkbook.Name
sheetType = UserForm1.ComboBox1.Value

CurrRow =  2 
Workbooks(mainBook).Activate
Range("A3:IV65536").ClearContents
Columns("B:B").NumberFormat = "@"
monthNum =  0 

For Each wSheet In Workbooks(dataBook).Sheets
    If (Left(wSheet.Name,  6 ) = "PROFIT" And sheetType = "PROFIT") _
            Or (Left(wSheet.Name,  3 ) = "QTY" And sheetType = "QTY") _
            Or (Left(wSheet.Name,  10 ) = "FACT_PRICE" And sheetType = "FACT_PRICE") Then
        monthNum = monthNum +  1 
        UserForm1.Caption = "Processing...  " & Str(Round((monthNum -  1 ) /  12  *  100 )) & "%"
        Select Case sheetType
            Case "PROFIT"
                If Mid(wSheet.Name,  8 ,  1 ) >  1  Then
                    Month = Mid(wSheet.Name,  8 ,  1 )
                Else
                    Month = Mid(wSheet.Name,  8 ,  2 )
                    If Month = "1_" Then Month = Mid(wSheet.Name,  8 ,  1 )
                End If
            Case "QTY"
                If Mid(wSheet.Name,  5 ,  1 ) >  1  Then
                    Month = Mid(wSheet.Name,  5 ,  1 )
                Else
                    Month = Mid(wSheet.Name,  5 ,  2 )
                    If Month = "1_" Then Month = Mid(wSheet.Name,  5 ,  1 )
                End If
            Case "FACT_PRICE"
                If Mid(wSheet.Name,  12 ,  1 ) >  1  Then
                    Month = Mid(wSheet.Name,  12 ,  1 )
                Else
                    Month = Mid(wSheet.Name,  12 ,  2 )
                    If Month = "1_" Then Month = Mid(wSheet.Name,  12 ,  1 )
                End If
        End Select
                
        Select Case Month
            Case  1 
                CurrColumn =  8 
            Case  2 
                CurrColumn =  11 
            Case  3 
                CurrColumn =  14 
            Case  4 
                CurrColumn =  17 
            Case  5 
                CurrColumn =  20 
            Case  6 
                CurrColumn =  23 
            Case  7 
                CurrColumn =  26 
            Case  8 
                CurrColumn =  29 
            Case  9 
                CurrColumn =  32 
            Case  10 
                CurrColumn =  35 
            Case  11 
                CurrColumn =  38 
            Case  12 
                CurrColumn =  41 
        End Select
        
        i =  6 
        Do
            ID = wSheet.Cells(i,  2 ).Value
            Articul = wSheet.Cells(i,  3 ).Value
            Name = wSheet.Cells(i,  4 ).Value
            Group = wSheet.Cells(i,  5 ).Value
            PodGroup = wSheet.Cells(i,  6 ).Value
            Production = wSheet.Cells(i,  7 ).Value
            Quantity = wSheet.Cells(i,  8 ).Value
            Fact = wSheet.Cells(i,  9 ).Value
            Zakup = wSheet.Cells(i,  9 ).Value - wSheet.Cells(i,  10 ).Value
            
            Cells( 2 ,  2 ).Activate
            findRow =  2 
            
            Set c = Range("B:B").Find(What:=Articul, After:=ActiveCell)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    c.Activate
                    If c.Formula = Articul Then GoTo label1
                    Set c = Range("B:B").FindNext
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
            
            If c Is Nothing Then Set c = Range("B2")

label1:
            If c.Row =  2  Then
                CurrRow = CurrRow +  1 
                Set c = Cells(CurrRow,  2 )
            End If
            
            Cells(c.Row,  1 ) = ID
            Cells(c.Row,  2 ) = Articul
            Cells(c.Row,  5 ) = Name
            Cells(c.Row,  3 ) = Group
            Cells(c.Row,  4 ) = PodGroup
            Cells(c.Row,  6 ) = Production
            Cells(c.Row, CurrColumn) = Cells(c.Row, CurrColumn) + Quantity
            Cells(c.Row, CurrColumn +  1 ) = Cells(c.Row, CurrColumn +  1 ) + Zakup
            Cells(c.Row, CurrColumn +  2 ) = Cells(c.Row, CurrColumn +  2 ) + Fact
            
            i = i +  1 
    Loop While (wSheet.Cells(i,  1 ).Formula <> "" And wSheet.Cells(i,  1 ).Formula <> "Сводка") 'i <= wSheet.Range("A65536").End(xlUp).Row
        
    End If
    
Next wSheet

'=================Протягиваем TOTAL=================
Range("AR3").Activate
ActiveCell.FormulaR1C1 = "=RC[-3]+RC[-6]+RC[-9]+RC[-12]+RC[-15]+RC[-18]+RC[-21]+RC[-24]+RC[-27]+RC[-30]+RC[-33]+RC[-36]"
Range("AR3").Select
Selection.AutoFill Destination:=Range("AR3:AT3"), Type:=xlFillDefault
Range("AR3:AT3").Select
Set c = Range(Cells( 4 , Range("AR4").Column), Cells(Range("A65536").End(xlUp).Row, Range("AT4").Column))
Selection.Copy
c.Select
ActiveSheet.Paste
    
Workbooks(dataBook).Close SaveChanges:=False
UserForm1.Hide
MsgBox "done"
End Sub