Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Объединить несколько книг в одну / 6 сообщений из 6, страница 1 из 1
25.07.2012, 10:02
    #37891609
plus_stick
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединить несколько книг в одну
Здравствуйте.
Есть несколько файлов в Excel, экспорт из 1С.
Можно ли их объединить в один файл, где названия листов соответствовали бы названиям файлов?
Каждый раз копировать очень рутинно, это надо выполнять регулярно.
Хотелось бы автоматизировать процесс.
Спасибо.
...
Рейтинг: 0 / 0
25.07.2012, 10:31
    #37891656
Serge 007
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединить несколько книг в одну
plus_stick,

а что дал поиск?
...
Рейтинг: 0 / 0
25.07.2012, 10:33
    #37891657
plus_stick
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединить несколько книг в одну
plus_stick,

Нашел такой код:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
Sub MergeMultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "D:\MyPath" ' change to suit
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(MyPath & "\*.xls", vbNormal)
    
    If Len(strFilename) = 0 Then Exit Sub
    
    Do Until strFilename = ""

            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
            
            Set wsSrc = wbSrc.Worksheets(1)
            
            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

            wbSrc.Close False
        
        strFilename = Dir()
        
    Loop
    wbDst.Worksheets(1).Delete
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub


Делает всё отлично.
Но названия листов идут пронумерованными, например TDSheet (1), TDSheet (2) и т.д.
Как можно модифицировать код, чтобы названия листов соотвествовали названиям файлов без расширения?
...
Рейтинг: 0 / 0
25.07.2012, 10:35
    #37891658
Serge 007
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединить несколько книг в одну
plus_stickназвания листов соотвествовали названиям файлов без расширения?
plus_stick,

а что дал поиск?
...
Рейтинг: 0 / 0
25.07.2012, 11:01
    #37891714
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединить несколько книг в одну
plus_stick,
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
...            
            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

            wbDst.Worksheets(wbDst.Worksheets.Count).Name = Left(strFilename, InStrRev(strFilename, ".") - 1)

            wbSrc.Close False
... 
...
Рейтинг: 0 / 0
25.07.2012, 12:39
    #37891959
plus_stick
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединить несколько книг в одну
Serge 007,

Поиск, к сожалению, ничего не дал.
Во всяком случае спасибо. С помощью поиска я решил львиную долю своей проблемы.
Поиск в рускоязычных сайтах ничего не дал, информации очень мало по моему запросу.
Возможно я плохо искал.
Пришлось искать в англоязычных ресурсах, там то я и нашел вышеприведенный код.

AndreTM

Спасибо за решение.
То, что надо.
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Объединить несколько книг в одну / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]