Sub LLL()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim Im_Main, Put_File, Put_File_SVOD, NAME_SVOD, schet, str_pch As Variant

Im_Main = ActiveWorkbook.Name
Put_File = Application.ActiveWorkbook.Path + "\БАЗА ДЛЯ СВОДА\"
Put_File_SVOD = Application.ActiveWorkbook.Path + "\"

Dim FS, KATALOG, FILE, MASSIV As Object
Set FS = CreateObject("Scripting.FileSystemObject")
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files

schet = 0
For Each FILE In MASSIV
schet = schet + 1
Next

Sheets("Свод").Select
Rows("2:65000").Select
Selection.Delete Shift:=xlUp

NAME_SVOD = Trim(Range("G1").Value)

str_pch = 2
If schet <> 0 Then
For Each FILE In MASSIV
Workbooks.Open Filename:=Trim(FILE)

Rows("2").Select
Selection.Copy

Windows(Im_Main).Activate
Rows(Trim(Str(str_pch)) + ":" + Trim(Str(str_pch))).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Windows(Dir(Trim(FILE))).Activate
ActiveWindow.Close

str_pch = str_pch + 1
Next
End If

Sheets("Свод").Copy

ActiveWorkbook.SaveAs Filename:= _
Put_File_SVOD + NAME_SVOD + ".XLS", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ActiveWindow.Close
MsgBox "ГОТОВО"
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub