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

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение нескольких файлов Excel в один, на разные листы (Макросы/Sub)

getbmah

Дата: Понедельник, 20.02.2017, 12:45 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Добрый день!

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

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

Ответить

Kuzmich

Дата: Понедельник, 20.02.2017, 14:28 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 711

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

Цитата

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

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

Ответить

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]

Ответить

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

Ответить

Страница 1 из 1
1