Здравствуйте уважаемые форумчане! :) В очередной раз нужна помощь профессионалов для написания макроса. :'(
Имеется книга 12345.xlsm (в приложении) с 2-мя листами. на 1-м листе есть кнопка, которая открывает окно выбора файлов. (GetOpenFile)
Задача: 1. Выбрать один или несколько файлов, можно несколько одновременно (выбираем файлы Excel) 2. Скопировать таблицу из выбранных файлов с Листа1 на Лист2 текущей книги (Важно, чтоб таблицу можно было пополнять) 3. Формат выбираемых файлов представлен в книге 123.xlsx (копировать надо только данные которые выделены зеленым, синие не надо) 4. Строк в таблице, в выбираемых файлах может быть много, 100 и больше
Спасибо!
Здравствуйте уважаемые форумчане! :) В очередной раз нужна помощь профессионалов для написания макроса. :'(
Имеется книга 12345.xlsm (в приложении) с 2-мя листами. на 1-м листе есть кнопка, которая открывает окно выбора файлов. (GetOpenFile)
Задача: 1. Выбрать один или несколько файлов, можно несколько одновременно (выбираем файлы Excel) 2. Скопировать таблицу из выбранных файлов с Листа1 на Лист2 текущей книги (Важно, чтоб таблицу можно было пополнять) 3. Формат выбираемых файлов представлен в книге 123.xlsx (копировать надо только данные которые выделены зеленым, синие не надо) 4. Строк в таблице, в выбираемых файлах может быть много, 100 и больше
Aleksej, опять информация не полная!!! Вы не указали, 1. Во всех ли файлах типа 123 таблицы идентичны. 2. Все ли данные начинаются с 9-й строки? Вам предложат макрос и окажется - не так, потому, что таблицы разные и начинаются с разных колонок и разных строк. А это уже другой подход.
Aleksej, опять информация не полная!!! Вы не указали, 1. Во всех ли файлах типа 123 таблицы идентичны. 2. Все ли данные начинаются с 9-й строки? Вам предложат макрос и окажется - не так, потому, что таблицы разные и начинаются с разных колонок и разных строк. А это уже другой подход.Wasilich
Wasilich, 1. Формат файлов идентичный 2. которые есть проверил все с 9 строки.
Извиняюсь, сразу забыл добавить, что там в конце таблицы есть ИТОГО, его тоже не надо копировать (копируются только строки таблицы) в приложении исправил.
Wasilich, 1. Формат файлов идентичный 2. которые есть проверил все с 9 строки.
Извиняюсь, сразу забыл добавить, что там в конце таблицы есть ИТОГО, его тоже не надо копировать (копируются только строки таблицы) в приложении исправил.Aleksej
Информация нужна не лично мне. А всем, кто решится помочь. Мои же варианты, как всегда, не совсем профессиональны, растянуты, типа для начинающих, как и я сам. У Сергея KuklP, весь код был бы ~ строчек 5-6. [vba]
Код
Sub www() Dim iFile$, rFile$, otkuda As Range rFile = ActiveWorkbook.Name 'рабочий файл iFile = Application.GetOpenFilename _ ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , False) iFile = Dir(iFile) 'Выбранный файл If iFile = "" Then Exit Sub 'нажата кнопка отмены - выход из процедуры End If 'MsgBox "Выбран файл: " & iFile Application.ScreenUpdating = False 'отключаем экран (что б не моргал) Application.Workbooks.Open Filename:=iFile 'открываем выбранный файл PS = Sheets("Лист1").Range("B" & Rows.Count).End(xlUp).Row 'номер последней заполненной строки листа Set otkuda = Sheets("Лист1").Range("A9:X" & PS) Workbooks(rFile).Activate 'активируем рабочий файл PS = Sheets("Лист2").Range("B" & Rows.Count).End(xlUp).Row + 1 'номер последней заполненной строки листа otkuda.Copy Sheets("Лист2").Range("B" & PS) Workbooks(iFile).Close Application.ScreenUpdating = True End Sub
Информация нужна не лично мне. А всем, кто решится помочь. Мои же варианты, как всегда, не совсем профессиональны, растянуты, типа для начинающих, как и я сам. У Сергея KuklP, весь код был бы ~ строчек 5-6. [vba]
Код
Sub www() Dim iFile$, rFile$, otkuda As Range rFile = ActiveWorkbook.Name 'рабочий файл iFile = Application.GetOpenFilename _ ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , False) iFile = Dir(iFile) 'Выбранный файл If iFile = "" Then Exit Sub 'нажата кнопка отмены - выход из процедуры End If 'MsgBox "Выбран файл: " & iFile Application.ScreenUpdating = False 'отключаем экран (что б не моргал) Application.Workbooks.Open Filename:=iFile 'открываем выбранный файл PS = Sheets("Лист1").Range("B" & Rows.Count).End(xlUp).Row 'номер последней заполненной строки листа Set otkuda = Sheets("Лист1").Range("A9:X" & PS) Workbooks(rFile).Activate 'активируем рабочий файл PS = Sheets("Лист2").Range("B" & Rows.Count).End(xlUp).Row + 1 'номер последней заполненной строки листа otkuda.Copy Sheets("Лист2").Range("B" & PS) Workbooks(iFile).Close Application.ScreenUpdating = True End Sub