Страницы: 1
RSS
Как получить информацию из нескольких книг?
 
Всем добрый вечер, нужна Ваша помощь в написании макроса (сам мало знаком с VBA).
Макрос должен открывать файл (файл excel), и копировать оттуда построчно данные, т.е. сначала скопировать первую строку, вставить ее в файл с макросом, после отформатировать должным образом (это я наверное смогу сам), потом вторую строку и т.д. (обязательно надо копировать построчно) и так пока в файле есть данные.

P.S. И как можно сделать так, чтобы макрос открывал несколько файлов, друг за другом, пока они не закончаться в папке?


Заранее спасибо.
 
Цитата
Максим написал: как можно сделать так,
Несложно. Создать тему в разделе платных заказов. Здесь: один вопрос - одна тема. Это в правилах форума написано. Не читали?

И измените ник. Просто Максимов здесь уже десяток, а разных Максимов с сотню наберется
 
Максим, вот вам 2 кода "для подумать". Объедините их и получится то, что вам нужно. Если что-то будет не понятно, спрашивайте.
1 код -  код открытия файла и копирования из него данных в файл с макросом
2 код -  перебор файлов в папке

1-й

Код
'код открытия файла и копирования из него данных в файл с макросом
Sub Test1()
Dim WB As Workbook
Dim Sht As Worksheet
Dim ThisSht As Worksheet
Dim FileName As String
Dim LastRow As Long
Dim i As Long
    
    Set ThisSht = ThisWorkbook.Worksheets("Лист1") 'лист, куда будем копировать в этом файле с макросом
    FileName = "D:\Excel\Test.xlsx" 'имя файла, который будем открывать и брать из него данные
    Set WB = Workbooks.Open(FileName) 'открываем файл
    Set Sht = WB.Worksheets("Лист1") 'или так Wb.ActiveSheet - имя листа с данными
    LastRow = Sht.Cells(Sht.Rows.Count, 1).End(xlUp).Row 'номер последней заполненной строк в столбце А (1)
        
    'цикл копирования строк построчно начиная со 2-й строки
    If LastRow < 2 Then Exit Sub 'если данных нет на листе, то выход
    For i = 2 To LastRow
        'код для примера, берём например, 3-ю строку из файла и копируем её в 3-ю строку нашего файла
        Range(Sht.Cells(i, 1), Sht.Cells(i, 10)).Copy ThisSht.Cells(i, 1)
    Next i
    
    WB.Close (False) 'закрываем файл из которого брали данные (не сохраняя его)
    
    MsgBox "Копирование завершено!", vbInformation, "Конец"
End Sub

2-й

Код
'перебор файлов в папке
Sub Test2()
Dim myPath As String, myName As String, WB As Workbook

    'отключаем визуализацию Excel
    Application.ScreenUpdating = False
    
    'окно выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Укажите рабочую папку"
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        myPath = .SelectedItems(1) & Application.PathSeparator
    End With

    'цикл по всем файлам указанного типа
    myName = Dir(myPath & "*.xls*")
    Do While myName <> ""
        'открываем очередной файл в режиме "Только для чтения" и присваиваем его переменной
        Set WB = Workbooks.Open(FileName:=myPath & myName, ReadOnly:=True)
        
        'делаем что надо
        
        'закрываем файл не сохраняя изменений в нём
        WB.Close SaveChanges:=False
        'определяем имя следующего файл в указаной директории
        myName = Dir
    Loop
    MsgBox "Обработка файлов в папке завершена!", vbInformation, "Конец"
End Sub
 
New, это неправильно. Один вопрос - одна тема. Пусть остается, но на будущее примите к сведению.
Страницы: 1
Наверх