Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сбор определенных данных со всех листов в одной книге, тольк в определенные ячейки
 
#1
23.01.2020 10:40:10
Добрый день! Не смогла найти подходящий макрос для решения задачи
В книге много страниц, одного формата. Надо на лист Сводная, в 1 столбец собрать ФИО со всех листов, а в 10 Место рождения. Хочется, чтоб данная задача решилась с помощью макроса.  
Изменено: EVaGuseva - 23.01.2020 14:08:14
 
 
 
#2
23.01.2020 11:12:13
Код
Sub main()
    Dim sh As Worksheet
    Dim sht As Worksheet
    Dim lrow&, arrfio(), arrdt()
    Set sht = ThisWorkbook.Worksheets("Сводная")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> sht.Name Then
            lrow = sh.Range("b" & sh.Rows.Count).End(xlUp).Row
            arrdt = sh.Range("c2:c" & lrow).Value
            arrfio = sh.Range("b2:b" & lrow).Value
            lrow = sht.Range("a" & sht.Rows.Count).End(xlUp).Row + 1
            sht.Range("a" & lrow).Resize(UBound(arrfio)).Value = arrfio
            sht.Range("j" & lrow).Resize(UBound(arrdt)).Value = arrdt
            Erase arrdt, arrfio
        End If
    Next sh
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#3
23.01.2020 12:39:51
Спасибо! Очень признательна
 
 
 
#4
24.01.2020 12:02:40
Добрый день! Помогите, плиз
Код есть, но в таблице не очищаются эти колонки, а до записываются.
И как еще сделать так, чтоб данные собирались только с Лист1 и Лист3?

Очень, очень надо
 
 
 
#5
24.01.2020 14:01:58
Цитата
в таблице не очищаются эти колонки, а до записываются.
Цитата
чтоб данные собирались только с Лист1 и Лист3?
Код
Sub main()
Dim sh As Worksheet
Dim sht As Worksheet
Dim lrow&, arrfio(), arrdt()
Dim ArrList
Dim i As Integer
  ArrList = Array("Лист1", "Лист2", "Лист3")
  Set sht = ThisWorkbook.Worksheets("Сводная")
  lrow = sht.Range("A" & sht.Rows.Count).End(xlUp).Row + 1
  Range("A2:J" & lrow).ClearContents
  'For Each sh In ThisWorkbook.Worksheets     'цикл по листам
  For i = 0 To UBound(ArrList)
      Set sh = ThisWorkbook.Worksheets(ArrList(i))
    If sh.Name <> sht.Name Then
      lrow = sh.Range("b" & sh.Rows.Count).End(xlUp).Row
      arrdt = sh.Range("c2:c" & lrow).Value  'дата рождения
      arrfio = sh.Range("b2:b" & lrow).Value 'ФИО
       lrow = sht.Range("a" & sht.Rows.Count).End(xlUp).Row + 1
       sht.Range("a" & lrow).Resize(UBound(arrfio)).Value = arrfio
       sht.Range("j" & lrow).Resize(UBound(arrdt)).Value = arrdt
       Erase arrdt, arrfio
    End If
  Next
End Sub
 
 
 
#6
28.01.2020 09:44:05
Спасибо большое, все очень корректно работает!
 
 
 
Страницы: 1
Наверх