Копирование из нескольких книг в одну сводную

[chib_sv]

Добрый день! Помогите скопировать все файлы .xls и .xlsx из указанной папки (этих файлов каждый раз будет разное) в файл который открыт, обязательно чтобы копирование проиходило без открытия диалогового окна для выбора папок. Заранее благодарю всех откликнувшихся!

[Serge_Bliznykov]

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

скопировать все файлы .xls и .xlsx из указанной папки (этих файлов каждый раз будет разное) в файл который открыт

начните отсюда - http://www.programmersforum.ru/showp...36&postcount=2

[chib_sv]

Я просматривал много вариантов решения такой задачи, но везде идет копирования с открытием диалогового окна, а мне нужно именно без выбора файлов. Просто все файлы .xls копируются и указанной папки и все листы вставляются открытый.

[Serge_Bliznykov]

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

Я просматривал много вариантов решения такой задачи, но везде идет копирования с открытием диалогового окна, а мне нужно именно без выбора файлов.

Конечно, вряд ли Вы найдёте 100% готовый и подходящий вашим хотелкам вариант.

значит, нужно взять подходящий код и доработать его - диалога выбора файлой/папки заменить на жёстко прописанный путь к вашей папке.

ну, или заинтересовать местных специалистов по VBA, чтобы они доработали макрос под ваши нужды.

[chib_sv]

Меня устраивает такой вариант, но как от туда убрать диалоговое окно я не знаю

Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
 
    Application.ScreenUpdating = False  'отключаем обновление экрана для скорости
     
    'вызываем диалог выбора файлов для импорта
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")
 
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        Exit Sub
    End If
     
    'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        importWB.Close savechanges:=False
        x = x + 1
    Wend
 
    Application.ScreenUpdating = True
End Sub

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

[Serge_Bliznykov]

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

как от туда убрать диалоговое окно я не знаю

какая у Вас версия MS Excel ?


вот ТУТ, например, есть код получения всех xls* файлов.

попробуйте у себя выполнить такой макрос (заменив путь "D:\datafolder\" на свой):

Sub ShowAllFilesInDirectory()
  Dim pt$, fn$
  pt = "D:\datafolder\"
  fn = Dir(pt & "*.xls*")
  Do While fn <> ""
      MsgBox "Found file: " & pt & fn
      fn = Dir
  Loop
End Sub

если отработает, то этот цикл и берите за основу.

[chib_sv]

будет использоваться офиис 2007 и 2010

[Serge_Bliznykov]

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

будет использоваться офиис 2007 и 2010

я выше привёл код, проверьте его в обоих версиях офиса (в MS Excel 2010 я проверил, он работает...).

[chib_sv]

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

[Serge_Bliznykov]

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

не пойму куда ваш код нужно вставить чтобы работало.

вы проверили работоспособность макроса ShowAllFilesInDirectory в ваших версиях Excel?