Добрый день. В екселе создавались реестры документов, каждый реестр отдельная страница (пример во вложении). Мне нужно собрать определенные данные со всей книги в два столбца: номер реестра (он всегда в одной и той же ячейки В1 находится) и № БГ (он находится в ячейках начиная с В8 и до В?, количество заполненных строк в каждой странице разное + перед ним есть текст который не нужен (убираю его при помощи =ПРАВСИМВ(B8;ПОИСК("№";B8 )
Добавьте в книгу лист Реестр и в его модуль скопируйте макрос
Код
Sub Reestr()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim FoundБГ As Range
Dim FirstБГ As String
Worksheets("Реестр").Cells.Clear
Worksheets("Реестр").Range("A1") = "Реестр"
Worksheets("Реестр").Range("B1") = "№ БГ"
For Each Sht In Worksheets
If Sht.Name <> "Реестр" Then ' кроме листа "Реестр"
With Sht
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range("B1").Copy Cells(iLastRow, 1)
Set FoundБГ = .Columns("B").Find("бг №", , xlValues, xlPart)
If Not FoundБГ Is Nothing Then
FirstБГ = FoundБГ.Address
Do
Cells(iLastRow, 2) = "бг №" & Split(.Cells(FoundБГ.Row, 2), "№")(1)
Set FoundБГ = .Columns("B").FindNext(FoundБГ)
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Loop While FoundБГ.Address <> FirstБГ
End If
End With
End If
Next
End Sub
Спасибо большое. Работает, но возникли небольшие проблемы возможны записей 4х видов т.к в ручную вносилось все БГ № 111111111 БГ №111111111 БГ№ 111111111 БГ№111111111 Макрос находит только 1 и 2 . и если, не сложно, можете поменять расстановку как в примере