Страницы: 1
RSS
Собрать данные со всех листов в книге по критерию и перенести в единый лист с указанием листов
 
Всем привет. Напишите,пожалуйста, макрос который будет
Имеется файл, в котором может быть разное кол-во листов. В файле только те листы, с которыми нужно работать, скрытых листов нет.
Нужно пройтись по каждому листу, начиная с первого, найти на 11 строке слово "Завод" скопировать все данные, по этому столбцу, ниже 11 строчки и перенести в новую книгу с указанием листа. Данные следующего листа разместить ниже в новой книги ( в один столбец ).

Все макросы, которые я нашла в интернете, позволяют только собирать либо всю информацию, либо столбики, а мне нужно именно по критерию
Шпасибо!
 
Цитата
SaraStyle написал:
Напишите,пожалуйста, макрос который будет
С такой постановкой вопроса вам в ветку работа
"Все гениальное просто, а все простое гениально!!!"
 
Вариант решения задачи через Power Query.
Изменено: turbidgirl - 24.06.2019 14:14:12
 
еще в PQ. c условием что выше строки 11 ничего не тронуто)
Код
let
    Source = Excel.Workbook(File.Contents("C:\abc\Лист Microsoft Excel (3).xlsx"), null, true),
    #"Filtered Rows" = Table.SelectRows(Source, each ([Name] <> "РЕЗУЛЬТАТ") and ([Kind] = "Sheet")),
    #"Added Custom1" = Table.AddColumn(#"Filtered Rows", "b", each Table.SelectColumns(Table.PromoteHeaders([Data], [PromoteAllScalars=true]),"Завод")),
    #"Removed Errors" = Table.RemoveRowsWithErrors(#"Added Custom1", {"b"}),
    #"Expanded {0}" = Table.ExpandTableColumn(#"Removed Errors", "b", { "Завод"})[[Завод],[Name]]
in
    #"Expanded {0}"
Изменено: artyrH - 24.06.2019 14:29:03
 
turbidgirl, artyrH, Через PQ нет возможности((((( К сожалению, простите, что сразу не написала  
 
так я и не для вас запрос сделал. в реальных условиях все равно, скорее всего, не сработало бы
 
Цитата
SaraStyle написал:
Через PQ нет возможности
Прям уверены? Неужто Эксель старше 2010 года?
Вот горшок пустой, он предмет простой...
 
PooHkrd, нет, надстройка заблок нашими службами (

Нужен код VBA, помогите, пожалуйста.  
 
При активном листе РЕЗУЛЬТАТ запустите макрос
Код
ub Sbor()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim Zavod As Range
  iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
  If iLastRow = 3 Then iLastRow = 4
  Range("C4:D" & iLastRow).Clear
    For Each Sht In Worksheets
      If Sht.Name <> "РЕЗУЛЬТАТ" Then
        With Sht
         Set Zavod = .Rows("11").Find("Завод", , xlValues, xlWhole)
          If Not Zavod Is Nothing Then
            iLR = .Cells(.Rows.Count, Zavod.Column).End(xlUp).Row
            iLastRow = Cells(Rows.Count, "C").End(xlUp).Row + 1
            .Range(.Cells(12, Zavod.Column), .Cells(iLR, Zavod.Column)).Copy Cells(iLastRow, "C")
            Cells(iLastRow, "D").Resize(iLR - 11) = Sht.Name
          End If
        End With
      End If
    Next
End Sub
 
Kuzmich,Спасибо!  
Страницы: 1
Наверх