Добрый день! Не смогла найти подходящий макрос для решения задачи В книге много страниц, одного формата. Надо на лист Сводная, в 1 столбец собрать ФИО со всех листов, а в 10 Место рождения. Хочется, чтоб данная задача решилась с помощью макроса.
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
"Все гениальное просто, а все простое гениально!!!"
Добрый день! Помогите, плиз Код есть, но в таблице не очищаются эти колонки, а до записываются. И как еще сделать так, чтоб данные собирались только с Лист1 и Лист3?
в таблице не очищаются эти колонки, а до записываются.
Цитата
чтоб данные собирались только с Лист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