Нужен совет в коде

Sub CommandButton1_Click()
Dim mARR(), i&, j&, dict As Object
Dim mstr$, cC As Range, aSHT As Sheets
Dim fName$, fPath$, arK, arI
   mARR = Application.GetOpenFilename _
            (" (*.xls),*.xls", , "SELECT   YOUR   FILES", , True)
   Application.ScreenUpdating = False
   Set dict = CreateObject("scripting.dictionary"): dict.comparemode = 1
   For i = LBound(mARR) To UBound(mARR)
   mstr = Mid(mARR(i), InStrRev(mARR(i), "\") + 1)
      With GetObject(mARR(i))
        fName = Mid(mARR(i), InStrRev(mARR(i), "\") + 1)
        fPath = Replace(mARR(i), fName, "", 1)
'         mstr = mARR(i)
         Application.DisplayAlerts = False
            For j = 1 To .Sheets.Count
               If .Sheets(j).Name = "Results" Then
                  .Sheets(j).Delete:  Exit For
               End If
            Next 'i
         Application.DisplayAlerts = True
         With .Sheets(1)
            j = .Cells(.Rows.Count, "a").End(xlUp).Row
            .Range(.Cells(1, 4), .Cells(.Rows.Count, .Columns.Count)).Delete
               For Each cC In .Range(.[a1], .Cells(.Rows.Count, "a").End(xlUp)). _
                                          SpecialCells(xlCellTypeConstants, 2).Cells
                  If dict.exists(Application.Trim(cC.Value)) Then
                     dict.Item(Application.Trim(cC.Value)) = _
                        Round(dict.Item(Application.Trim(cC.Value)) + _
                           CDbl(cC.Offset(0, 2).Value), 2)
                              Else
                                 dict.Add Application.Trim(cC.Value), Round(CDbl(cC.Offset(0, 2).Value), 2)
                  End If
               Next 'cC
            End With ' .Sheets(1)
            arK = dict.keys:  arI = dict.items
            With .Sheets.Add
               .Name = "Results"
               'here you can change points to insert data
               .[a1].Resize(UBound(arK), 1).Value = Application.Transpose(arK)
               .[b1].Resize(UBound(arI), 1).Value = Application.Transpose(arI)
               .Columns.EntireColumn.AutoFit
               dict.RemoveAll
            End With '.Sheets.Add
            .SaveCopyAs Filename:=fPath & "Copy_" & fName
            .Close 0
         End With 'GetObject(mARR(i))
   Next 'i
   Application.ScreenUpdating = True
   Set dict = Nothing: MsgBox Space(10) & "D O N E!"
End Sub

Private Sub CommandButton1_Click()
 
Dim FSO As Object
Dim TheFolder As Object, TheFiles As Object, AFile As Object, wb As Workbook, xls
Dim mstr$
MyPath = "c:\1111\"
Application.ScreenUpdating = False
Set wb = Workbooks.Add(template:=xlWorksheet)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFolder = FSO.GetFolder(MyPath) 'Каталог, откуда суммировать
Set TheFiles = TheFolder.Files
 
For Each AFile In TheFiles
If UCase(FSO.GetExtensionName(AFile.Path)) = "XLS" Then
Set xls = Workbooks.Open(Filename:=AFile, ReadOnly:=False) '
ActiveSheet.Copy After:=Sheets(ActiveSheet.Index)
   With Workbooks(AFile.Name)
      Call qqq(.Sheets(1).Name)
   End With
End If
'===End========================================
Sheets(2).Columns("A:C").Select
    Selection.ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close True
Next
 
MsgBox "Виконано"
' Нічого тут не виконано. Ще опрацьовувати "звечора і до рання"
 
 
End Sub

Sub qqq(shtN As String)
 
 Dim a, b As String
 Dim n, m As Integer
 Dim sum As Currency
 With Sheets(shtN)
  n = 1
  m = 1
  a = .Cells(n, 1)
Do While (.Cells(n, 1) <> "")
    sum = 0
    Do
     If .Cells(n, 2) = "ЕСВ ФОТ (работники)" Then sum = sum + .Cells(n, 3)
     n = n + 1
     b = .Cells(n, 1)
    
    Loop Until (a <> b)
    If sum <> 0 Then
      .Cells(m, 4) = a
      .Cells(m, 5) = sum
      m = m + 1
    End If
 a = b
 
 Loop
 End With
 
End Sub

Private Sub CommandButton1_Click()
 
Dim FSO As Object
Dim TheFolder As Object, TheFiles As Object, AFile As Object, wb As Workbook, xls
Dim mstr$, MyPath$
   MyPath = "C:\1111\"
   Application.ScreenUpdating = False
   'Set wb = Workbooks.Add(template:=xlWorksheet) '????????
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set TheFolder = FSO.GetFolder(MyPath) 'Каталог, откуда суммировать
   Set TheFiles = TheFolder.Files
   For Each AFile In TheFiles
      mstr = AFile.Name
      If UCase(FSO.GetExtensionName(AFile.Path)) = "XLS" Then
      Set xls = Workbooks.Open(Filename:=AFile, ReadOnly:=False) '
      ActiveSheet.Copy After:=Sheets(ActiveSheet.Index)
            Call qqq
      End If
   '===End========================================
      ActiveWorkbook.Save
      ActiveWorkbook.Close True
   Next
 
MsgBox "Виконано"
 
End Sub
 
Sub qqq()
' a - первое значение имени, Б- второе значение имени
Dim a, b As String
Dim n, m As Integer
Dim sum As Currency
   With ActiveSheet
      n = 1
      m = 1
      a = .Cells(n, 1)
         Do While (.Cells(n, 1) <> "")
             sum = 0
             Do
                  If .Cells(n, 2) = "ЕСВ ФОТ (оплата труда)" Then sum = sum + .Cells(n, 3)
               n = n + 1
               b = .Cells(n, 1)
             Loop Until (a <> b)
                  If sum <> 0 Then
                    .Cells(m, 4) = a
                    .Cells(m, 5) = sum
                    m = m + 1
                  End If
               a = b
          Loop
      .Columns("A:C").EntireColumn.Delete
      .Columns.EntireColumn.AutoFit
   End With
End Sub