For Each f in fol.files
'f - файл
'fol - папка с этими файлами
'открываем каждый файл, копируем лист Свод_кв, вставляем в ThisWorkbook, закрываем
Next f

Const sPath = "C:\Documents and Settings\_тест"

Option Explicit
Dim fso As FileSystemObject

Const sPath = "C:\Documents and Settings\kutenko\Рабочий стол\Работа\_тест" '"G:\DEPTS\ANALITIK\Bankbase\_01122008bankbase" '"C:\_01102008bankbase"'"C:\_01102008bankbase" '"G:\DEPTS\ANALITIK\Bankbase\_01102008bankbase" '"C:\_01102008bankbase"

Dim book As Workbook
Dim sh As Worksheet
Public Sub CommandButton1_Click()

Dim fol As Folder
Dim f As File
Dim sTemp As String
Dim nTemp As Long
Dim b As Workbook
Dim she As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set fso = New FileSystemObject
Set fol = fso.GetFolder(sPath)
' Ходим по всем файлам в папке
    she =  1 
    For Each f In fol.Files
        ' Проверяем, что-бы длина имени файла была больше 3 символов
        If Len(f.Name) >  3  Then
            sTemp = LCase(Right(f.Name,  3 ))
                If sTemp = "xls" Then
                    Set b = Application.Workbooks.Open(f.Path)
                        b.Sheets("Свод_кв").Copy After:=Workbooks("СводБДР пл-фт.xls").Sheets(she)
                    she = ThisWorkbook.Sheets.Count
                    ThisWorkbook.Sheets(she).Name = f.Name
                    
                End If
        End If ' If Len(f.Name) > 3 Then
        Application.Workbooks(f.Name).Close False
    Next f

Set fol = Nothing
Set f = Nothing
Set fso = Nothing
Set sh = Nothing
Set b = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "готово :)"
End Sub

Const sPath = "C:\Documents and Settings\_тест"

b.Sheets("Свод_кв").Copy After:=Workbooks("_Свод БДР МПП_05.2009г.xls").Sheets(she)

b.Sheets("Свод_кв").Copy After:=Workbooks(thisworkbook.name).Sheets(she)

b.Sheets("Свод_кв").Copy After:=Workbooks("СводБДР пл-фт.xls").Sheets(she) 'моя строчка
b.Sheets("Свод_кв").Copy After:=Workbooks("_Свод БДР МПП_05.2009г.xls").Sheets(she) 'ваша 

Dim fso As FileSystemObject