Private Sub CommandButton1_Click()

Dim FSO As Object
Dim TheFolder As Object, TheFiles As Object, AFile As Object
Stop
'MyPath = "c:\1111\"""
Application.ScreenUpdating = False
'Set wb = Workbooks.Add(template:=xlWorksheet)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFolder = FSO.GetFolder("C:\1111\") 'Каталог, откуда суммировать
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)

'Application.Run ("Шпола.xls!qqq")
'Application.Run ("Шпола1.xls!qqq")

'xls.Sheets(1).Copy 'After:=wb.Sheets(wb.Sheets.Count)
'xls.Sheets(2).PasteSpecial Paste:=xlPasteValues
'xls.ActiveSheet.Copy After:=Sheets(1)
'Sheets(1).Copy After:=Sheets(Sheets.Count)
'Sheets(Sheets.Count).Name = ("Результат")
'Sheets(1).Activate
qqq
xls.ActiveSheet.Copy After:=Sheets(ActiveSheet.Index)

'Cells(1, 5) = strResult

'ThisWorkbook.Worksheets(1).Activate
End If

'Sheets(2).Columns("A:C").Select
'    Selection.ClearContents
   

ActiveWorkbook.Save
ActiveWorkbook.Close True
Next

MsgBox "Виконано"

End Sub

Sub qqq()

' Макрос1 Макрос
' Макрос записан 17.09.2013 (Администратор)
'

' a - первое значение имени, Б- второе значение имени
' Set wsh = Workbooks.Worksheets(1)
Dim a, b As String
  Dim n, m As Integer
  Dim sum As Currency
   
  'Stop
   
  With ActiveSheet
   n = 1
   m = 1
   a = .Cells(n, 1)
Do While (.Cells(n, 1) <> vbNullString)
     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