Максим, вот вам 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 |