Копирование из нескольких книг в одну сводную

[Serge_Bliznykov]

вот так. пробуйте. я работоспособность не проверял:

Sub CombineWorkbooks()
	Dim pt$, fn$
 
	Application.ScreenUpdating = False  'отключаем обновление экрана для скорости


     
	pt = "D:\datafolder\"
	fn = Dir(pt & "*.xls*")

	'проходим по всем файлам в заданном каталоге
	Do While fn <> ""
		' MsgBox "Found file: " & pt & fn

        	Set importWB = Workbooks.Open(Filename:=pt & fn)
		Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
		importWB.Close savechanges:=False

		fn = Dir  'взять имя следующего файла
	Loop

	Application.ScreenUpdating = True
End Sub

[chib_sv]

Работает, спасибо большое!!!

[Serge_Bliznykov]

не за что