Объединение нескольких файлов .xls в один в качестве листов.

[tibhar940]

Подскажите, пожалуйста.

Есть несколько файлов 1.xls и 2.xls (каждый состоит из одного листа -"1", "2"). Нужно объединить их в файл 3.xls чтобы они отображались в файле как листы ("1", "2").

Заранее спасибо.

Вот в принципе я написал макрос как из определённой папки копировать все листы в открытую книгу.

Sub Макрос2()
Set Fso = CreateObject("Scripting.FileSystemObject")
Set folder = Fso.GetFolder("C:\test")
For Each File In folder.Files
With Workbooks.Open(File.Path).Worksheets(1)
Sheets.Move Before:=Workbooks("Книга1").Sheets(1)
End With
Next

End Sub

Подскажите, как эти листы назвать также как файлы в которых эти листы находятся.

[tibhar940]

Дописал до удобоваримого вида. (Листы назвал также как файлы, в которых эти листы находятся).

Sub kkk()
Set Fso = CreateObject("Scripting.FileSystemObject")
Set folder = Fso.GetFolder("C:\test")
For Each File In folder.Files
With Workbooks.Open(File.Path).Worksheets(1)
.Name = ActiveWorkbook.Name
.Parent.Close -1
End With
With Workbooks.Open(File.Path).Worksheets(1)
Sheets.Move Before:=Workbooks("Книга1").Sheets(1)
End With
Next
End Sub

НО! Хочется удалить из получившихся названий листов ".xls"
Как это сделать?

[Hugo121]

Как-то через ж...
Проще ведь переименовать после копирования первый лист - запишите рекордером и вставьте в код.
А в имени можно заменой убрать расширение (его можно точно узнать средствами FSO, раз уж всё равно через него действуете).

[tibhar940]

Сообщение от Hugo121

Как-то через ж...
Проще ведь переименовать после копирования первый лист - запишите рекордером и вставьте в код.

Ну как уж есть) Зачем, здесь у меня сразу обзываются листы как надо и копируются в нужную книгу. А если буду делать иначе - придется лезть в эту папку и как-то вычленять названия для каждого из листов в конечной книге?

Сообщение от Hugo121

А в имени можно заменой убрать расширение (его можно точно узнать средствами FSO, раз уж всё равно через него действуете).

Да я знаю, что заменой можно. Но у меня как-то не получается. Всё-то ругается оно.
пробую в цикле использовать что-то типа

.activeworksheets.replace ".xls", " "

Но оно ругается. Можете что-нибудь дельное по этому поводу подсказать? А то уже что-то не знаю что использовать.

[Hugo121]

Sub kkk()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set folder = FSO.GetFolder("C:\test")
        For Each File In folder.Files
            With Workbooks.Open(File.Path).Worksheets(1)
                       .Move Before:=ThisWorkbook.Sheets(1)
                    ThisWorkbook.Sheets(1).Name = _
                    Replace(File.Name, "." & FSO.GetExtensionName(File.Path), "")
            End With
        Next
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Если в открываемых книгах больше одного листа - то их нужно закрывать. Если один - то не нужно. Но не стал заморачиваться...