Типа так
[vba]Код
Sub ЛистыВкнигу()
Dim iPath$, fail$
Application.ScreenUpdating = False: Application.EnableEvents = False: Application.DisplayAlerts = False
iPath = "C:\Отчеты\"
fail = Dir(iPath)
Do While fail <> ""
Workbooks.Open Filename:=iPath & fail
ActiveSheet.Copy Before:=Workbooks("Общий").Sheets(1)
ActiveSheet.Name = Mid(fail, 1, InStrRev(fail, ".") - 1)
Windows(fail).Activate
ActiveWorkbook.Close
fail = Dir
Loop
Application.ScreenUpdating = True: Application.EnableEvents = True: Application.DisplayAlerts = True
End Sub
[/vba]