Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Объединение нескольких файлов Excel в один, на разные листы - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение нескольких файлов Excel в один, на разные листы (Макросы/Sub)
Объединение нескольких файлов Excel в один, на разные листы
getbmah Дата: Понедельник, 20.02.2017, 12:45 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день!

Имеется несколько (в данном случае - 30) однотипных таблиц excel, в каждом файле по одному листу. Стоит задача собрать все файлы в один с сохранением форматирования, но не в общий лист, а чтобы каждый файл содержался на отдельном листе, в идеале - чтобы каждый лист носил имя соответствующего объединяемого файла, и чтобы эти объединяемые файлы можно было считать из папки.
Пробовал загуглить, нашлось очень много схожих, но не таких тем. Прошу помочь или ткнуть в нос готовым вариантом.
Заранее спасибо!


Сообщение отредактировал getbmah - Понедельник, 20.02.2017, 13:49
 
Ответить
СообщениеДобрый день!

Имеется несколько (в данном случае - 30) однотипных таблиц excel, в каждом файле по одному листу. Стоит задача собрать все файлы в один с сохранением форматирования, но не в общий лист, а чтобы каждый файл содержался на отдельном листе, в идеале - чтобы каждый лист носил имя соответствующего объединяемого файла, и чтобы эти объединяемые файлы можно было считать из папки.
Пробовал загуглить, нашлось очень много схожих, но не таких тем. Прошу помочь или ткнуть в нос готовым вариантом.
Заранее спасибо!
Автор - getbmah
Дата добавления - 20.02.2017 в 12:45
Kuzmich Дата: Понедельник, 20.02.2017, 14:28 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 715
Репутация: 157 ±
Замечаний: 0% ±

Excel 2003
Цитата
объединяемые файлы можно было считать из папки.

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

Циклом считываете файлы из этой папки.
В объединенном файле добавляете новый лист, копируете на него данные из открытого файла.
Переименовываете лист.
Закрываете файл и открываете следующий
Автор - Kuzmich
Дата добавления - 20.02.2017 в 14:28
Wasilich Дата: Понедельник, 20.02.2017, 18:46 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация: 326 ±
Замечаний: 0% ±

2003
Типа так :)
[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]
 
Ответить
СообщениеТипа так :)
[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]
Автор - Wasilich
Дата добавления - 20.02.2017 в 18:46
getbmah Дата: Вторник, 21.02.2017, 10:38 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо!
ps наткнулся на еще один способ:
Цитата

Sub CombineWorkbooksv1()
Dim FilesToOpen
Dim x As Integer
Dim wbk As Workbook
Dim wbk2 As Workbook
On Error GoTo ErrHandler
Set wbk = ActiveWorkbook
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No files!"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Set wbk2 = Workbooks.Open(Filename:=FilesToOpen(x))
wbk2.Sheets().Move After:=wbk.Sheets(wbk.Sheets.Count)
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

Думаю, вопрос закрыт.


Сообщение отредактировал getbmah - Вторник, 21.02.2017, 10:39
 
Ответить
СообщениеСпасибо!
ps наткнулся на еще один способ:
Цитата

Sub CombineWorkbooksv1()
Dim FilesToOpen
Dim x As Integer
Dim wbk As Workbook
Dim wbk2 As Workbook
On Error GoTo ErrHandler
Set wbk = ActiveWorkbook
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No files!"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Set wbk2 = Workbooks.Open(Filename:=FilesToOpen(x))
wbk2.Sheets().Move After:=wbk.Sheets(wbk.Sheets.Count)
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

Думаю, вопрос закрыт.
Автор - getbmah
Дата добавления - 21.02.2017 в 10:38
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение нескольких файлов Excel в один, на разные листы (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!