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

а что дал поиск?
...
Рейтинг: 0 / 0
Объединить несколько книг в одну
    #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
Объединить несколько книг в одну
    #37891658
Фотография Serge 007
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
plus_stickназвания листов соотвествовали названиям файлов без расширения?
plus_stick,

а что дал поиск?
...
Рейтинг: 0 / 0
Объединить несколько книг в одну
    #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
Объединить несколько книг в одну
    #37891959
plus_stick
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Serge 007,

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

AndreTM

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


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