Здравствуйте!
Передо мной на данный момент стоит такая задача: из нескольких книг excel мне нужно собрать данные таблиц в одну таблицу. У всех таблиц одинаковые столбцы, но разное количество заполненных строк (от 2 до 15).
Нашла в интренете похожий на нужный код и подогнала его под свою задачу.
С этим кодом у меня только две проблемы (с моим уровнем в VBA я не смогла решить, все только сбиватся и становится хуже):
1) Никак не могу настроить так, чтобы он останавливался на последней заполненной строке в выгружаемой таблице. На данный момент остановилась на решении копировать все 15 строчек, но это выглядит как "три заполненных строчки, 12 пустых, 4 заполненных, 11 пустых и т.д."
2) Насколько я поняла, он выгружает все в первую свободную строку листа. Однако, у меня есть оформление для таблицы (в которую объядиняются другие), и он выгружает данные не в нее, а "под ней". Как задать код таким образом, чтобы всегда он заполнял строчки, начиная с А3?
Заранее спасибо!
Макрос на данный момент:
Передо мной на данный момент стоит такая задача: из нескольких книг excel мне нужно собрать данные таблиц в одну таблицу. У всех таблиц одинаковые столбцы, но разное количество заполненных строк (от 2 до 15).
Нашла в интренете похожий на нужный код и подогнала его под свою задачу.
С этим кодом у меня только две проблемы (с моим уровнем в VBA я не смогла решить, все только сбиватся и становится хуже):
1) Никак не могу настроить так, чтобы он останавливался на последней заполненной строке в выгружаемой таблице. На данный момент остановилась на решении копировать все 15 строчек, но это выглядит как "три заполненных строчки, 12 пустых, 4 заполненных, 11 пустых и т.д."
2) Насколько я поняла, он выгружает все в первую свободную строку листа. Однако, у меня есть оформление для таблицы (в которую объядиняются другие), и он выгружает данные не в нее, а "под ней". Как задать код таким образом, чтобы всегда он заполнял строчки, начиная с А3?
Заранее спасибо!
Макрос на данный момент:
| Код |
|---|
Sub Agregator()
Dim iBeginRange As Object, lCalc As Long, lCol As Long
Dim oAwb As String, sCopyAddress As String, sSheetName As String
Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
Dim wbAct As Workbook
Dim bPasteValues As Boolean
On Error Resume Next
'Выбираем диапазон выборки с книг
Set iBeginRange = Range("$K$3:$AG$17")
'Указываем имя листа
sSheetName = "Risk Report"
'Запрос сбора данных с книг
avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
If VarType(avFiles) = vbBoolean Then Exit Sub
bPolyBooks = True
lCol = 1
'отключаем обновление экрана, автопересчет формул и отслеживание событий
'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды
With Application
lCalc = .Calculation
.ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
End With
'выбираем лист в книге для сбора
Set wsDataSheet = Sheet1
'цикл по книгам
For li = LBound(avFiles) To UBound(avFiles)
Set wbAct = Workbooks.Open(Filename:=avFiles(li))
oAwb = wbAct.Name
'цикл по листам
For Each wsSh In wbAct.Sheets
If wsSh.Name Like sSheetName Then
With wsSh
sCopyAddress = iBeginRange.Address
lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
'вставляем имя книги, с которой собраны данные
If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(Range(sCopyAddress).Rows.Count).Value = oAwb
'вставляем только значения
.Range(sCopyAddress).Copy
wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, 1).PasteSpecial xlPasteValues
End With
End If
NEXT_:
Next wsSh
If bPolyBooks Then wbAct.Close False
Next li
With Application
.ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
End With
End Sub
|
