Страницы: 1
RSS
Макрос копирования данных из файлов
 
Есть задача: быстро по нажатию кнопки (макросом, файл Результат) получить в таблицу суммы из файлов, которые лежат в определенной папке, а также их названия. Исходные данные: сами файлы (см. вложение). Их может быть до 100 шт, с разными названиями. Общее у этих файлов (логика): в каждом файле только 1 раз встречается символ "Х" (строки символа разные, столбец всегда один и тот же) и в одной строке с ним искомая нами сумма (строки также разные, но столбец суммы всегда единый).
Как должно работать: Нажимаем кнопку Сумма, выделяем нужные нам файлы, нажимаем Ок - все разносится.
Вопрос типовой, может быть полезен многим пользователем, буду признателен за Ваше решение. Заранее спасибо.
 
Евгений И.,  
в модуль книги результат и задать путь к файлам
Код
Sub OtkritVseKnigi()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Шаг 1:Объявляем переменные
Dim MyFiles As String, cell As Range, r As Long, wb As Workbook
Set wb = ThisWorkbook
k = 2
road = "C:\Users\Desktop\Евгений И\файлы тут\" 'папка с файлами
'Шаг 2: Укажите нужную папку из какой будем брать файлы excel
MyFiles = Dir(road & "*.xls*")
Do While MyFiles <> ""
x = Left(MyFiles, InStr(1, MyFiles, ".") - 1)
'Шаг 3: Открываем файлы один за другим
Workbooks.Open road & MyFiles
'Код макроса с действиями
With Workbooks(MyFiles).Worksheets(1)
    r = .Cells(1, 1).SpecialCells(xlLastCell).Row
    c = .Cells(1, 1).SpecialCells(xlLastCell).Column
    Set cell = .Range(.Cells(1, 1), .Cells(r, c)).Find("Х")
    myval = .Range("BE" & cell.Row)
    wb.Worksheets(1).Cells(k, 1) = x
    wb.Worksheets(1).Cells(k, 2) = myval
    k = k + 1
End With
ActiveWorkbook.Close SaveChanges:=True
'Шаг 4: Следующий файл в папке
MyFiles = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Изменено: Mershik - 21.10.2020 09:52:47
Не бойтесь совершенства. Вам его не достичь.
 
Отличное решение, все работает! Большое спасибо за Ваш ответ!))
Страницы: 1
Наверх