Страницы: 1
RSS
Копирование данных из книг с определенным названием
 
Добрый день!
Пытаюсь перебрать файлы в папке и копировать данные только из тех, чье имя содержит "20", например.
Код
Dim abook As Workbook
    Set abook = ActiveWorkbook
    Dim fileway As String, Objct As String
    Dim xlfile As Excel.Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "OK"
        .Title = "Выбери папку"
        If .Show = 0 Then
            Exit Sub
        End If
        fileway = .SelectedItems(1)
    End With
    Objct = Dir(PathName:=fileway + "\*.xlsx")
    Do Until Objct = ""
        Set xlfile = Workbooks(fileway + "\" + Objct)
        nm = xlfile.Name
        If nm Like "*20*.xlsx*" Then
            lrg = abook.Sheets("Svod").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("List1").Select
            [A1].Copy abook.Sheets("Svod").Cells(lrg + 1, 1)
        End If
        xlfile.Close
        Objct = Dir
    Loop
    Set xlfile = Nothing

Вот тут:
Код
Set xlfile = Workbooks(fileway + "\" + Objct)
возникает ошибка Subscript out of range
Можно конечно сделать так:
Код
Set xlfile = Workbooks.Open(fileway + "\" + Objct)
все работает, но макрос открывает по очереди все книги, а это долго.
Подскажите, пожалуйста какой метод использовать вместо Open
 
вместо Open вообще используйте Open требуемых файлов
Код
Objct = Dir(PathName:=fileway + "\*20*.xlsx")
Do Until Objct = ""
  with Workbooks.open(fileway + "\" + Objct)
    .WorkSheets("List1").[A1].Copy abook.Sheets("Svod").Cells(Rows.Count, 1).End(xlUp).offset(1,0)
    .Close False
  end with
  Objct = Dir
Loop
Изменено: Ігор Гончаренко - 04.02.2019 23:18:45
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко,Спасибо!!! Похоже я все усложнил. Действительно, все гораздо проще можно сделать!
 
Если нужно только значение (как в общем звучит название темы) известной ячейки известного листа известной книги - можно не открывая книгу взять это значение обычным =
И затем заменить на вытянутое значение.
Ну а если нужны все форматы - тогда конечно Copy...
Изменено: Hugo - 04.02.2019 23:33:12
 
В конкретном коде это
Код
Dim abook As Workbook
    Set abook = ActiveWorkbook

можно заменить на это
Код
Dim abook As Worksheet
    Set abook = ActiveWorkbook.Worksheets("Svod")

А к файлу можно обращаться с помощью GetObgect
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1
Наверх