Здравствуйте. Прошу помощи в решении следующей задачи: необходим макрос, который сможет перебрать несколько книг Excel из папки, и скопировать данные в новую книгу на один лист. Файл "Пример итогового отчёта"- то, как должен выглядеть результат. Файл "Заявки от 100" - один из однотипных файлов, которые необходимо перебрать. Кол-во таких файлов может меняться. Из файла "Заявки от 100" необходимо скопировать данные из листов с заявками - наименование таких листов начинается с "№...". Количество листов с заявками может меняться, и количество строк на данных листах может меняться. Так же необходимо добавить данные с листа "АФЭГ" согласно номеру заявки. Вставить данные необходимо в новую книгу, на один лист, друг за другом, без пустых строк. Очень нужен макрос, с подробным описанием действий.
Здравствуйте. Прошу помощи в решении следующей задачи: необходим макрос, который сможет перебрать несколько книг Excel из папки, и скопировать данные в новую книгу на один лист. Файл "Пример итогового отчёта"- то, как должен выглядеть результат. Файл "Заявки от 100" - один из однотипных файлов, которые необходимо перебрать. Кол-во таких файлов может меняться. Из файла "Заявки от 100" необходимо скопировать данные из листов с заявками - наименование таких листов начинается с "№...". Количество листов с заявками может меняться, и количество строк на данных листах может меняться. Так же необходимо добавить данные с листа "АФЭГ" согласно номеру заявки. Вставить данные необходимо в новую книгу, на один лист, друг за другом, без пустых строк. Очень нужен макрос, с подробным описанием действий.lАлександраl
К сообщению приложен файл:__.xls
(52.0 Kb)
·
__100.xlsx
(56.5 Kb)
Сообщение отредактировал lАлександраl - Четверг, 22.03.2018, 09:59
Sub СобратьФайлыНаОдинЛист() Dim wbW As Workbook, sh As Worksheet Workbooks.Add Set wbW = ActiveWorkbook Set sh = ActiveSheet
Dim sFolder As String, sFiles As String 'диалог запроса выбора папки с файлами With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) End With ' Stop sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> "" 'Call ГраницыБольшогоДиапазона(sh) 'открываем книгу Workbooks.Open sFolder & sFiles 'действия с файлом 'ActiveWorkbook.Sheets(1).UsedRange.Copy sh.cells(lRow + 1, fCol) 'Закрываем книгу без сохранения изменений ActiveWorkbook.Close False sFiles = Dir Loop MsgBox "Выход" End Sub
[/vba]
Привет! Начинаю "кашу из топора"
[vba]
Код
Sub СобратьФайлыНаОдинЛист() Dim wbW As Workbook, sh As Worksheet Workbooks.Add Set wbW = ActiveWorkbook Set sh = ActiveSheet
Dim sFolder As String, sFiles As String 'диалог запроса выбора папки с файлами With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) End With ' Stop sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> "" 'Call ГраницыБольшогоДиапазона(sh) 'открываем книгу Workbooks.Open sFolder & sFiles 'действия с файлом 'ActiveWorkbook.Sheets(1).UsedRange.Copy sh.cells(lRow + 1, fCol) 'Закрываем книгу без сохранения изменений ActiveWorkbook.Close False sFiles = Dir Loop MsgBox "Выход" End Sub
lАлександраl, Если будем дальше варить кашу, то с Вас таблица соответствия столбцов книги листа книги "Пример итогового отчёта" и листа "№...". И сделаю процедуру вставки заявок.
lАлександраl, Если будем дальше варить кашу, то с Вас таблица соответствия столбцов книги листа книги "Пример итогового отчёта" и листа "№...". И сделаю процедуру вставки заявок.InExSu
Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
InExSu, здравствуйте! Спасибо! Я правильно понимаю, что "отрихтовать Заявку" означает, что вы удалили столбцы со спец-ей? Больше ничего не изменилось, вроде... Я запускаю макрос, сразу показывает [vba]
Код
MsgBox "Выход"
[/vba] и на этом всё. Диалог запроса выбора папки с файлами добавила свой, в папке есть заявки формата xls. В чём может быть ошибка? И не понимаю где в макросе обработка листов "АФЭГ"? Нашла только закомментированную строку: [vba]
Код
'If InStr(shSour.Name, "АФЭГ") > 1 Then АФЭГ_парсер
[/vba]
InExSu, здравствуйте! Спасибо! Я правильно понимаю, что "отрихтовать Заявку" означает, что вы удалили столбцы со спец-ей? Больше ничего не изменилось, вроде... Я запускаю макрос, сразу показывает [vba]
Код
MsgBox "Выход"
[/vba] и на этом всё. Диалог запроса выбора папки с файлами добавила свой, в папке есть заявки формата xls. В чём может быть ошибка? И не понимаю где в макросе обработка листов "АФЭГ"? Нашла только закомментированную строку: [vba]
Код
'If InStr(shSour.Name, "АФЭГ") > 1 Then АФЭГ_парсер