Консолидирование листов на один лист в текущюю книгу

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Консолидирование листов на один лист в текущюю книгу (Макросы/Sub)

frukti4ek

Дата: Вторник, 21.07.2015, 15:51 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 0 ±

Замечаний: 20% ±

Добрый день.

есть макрос по консолидации информации на один лист со всех листов в файле
в макросе прописан диапазон сбора информации

Мне необходимо , чтобы вытягивалась информация со всего листа, в независимости от диапазона
Подскажите пожалуйста где исправить

[vba]

Код

Sub sborka()
If MsgBox("Сборка производится на первый лист, правильно?", vbYesNo + vbDefaultButton2) = 6 Then
Sheets(1).Range("a1").CurrentRegion.Clear
s_ = Sheets.Count
Sheets(2).Range("1:1").Copy Sheets(1).Range("a1")
For i = 2 To s_
r_ = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row + 1
Sheets(i).Range("a1").CurrentRegion.Offset(1).Copy Sheets(1).Range("a" & r_)
Next
End If
End Sub

[/vba]

Буду очень благодарна за помощь
[moder]Используйте спецтеги форматирования. Для кода макроса - кнопка #

К сообщению приложен файл: 2578515.xls (56.0 Kb)

Сообщение отредактировал _Boroda_ - Вторник, 21.07.2015, 16:09

Ответить

_Boroda_

Дата: Вторник, 21.07.2015, 16:20 | Сообщение № 2

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Так нужно?
[vba]

Код

Sub sborka()
     If MsgBox("Сборка производится на первый лист, правильно?", vbYesNo + vbDefaultButton2) = 6 Then
         Sheets(1).Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Clear
         s_ = Sheets.Count
         Sheets(2).Range("1:1").Copy Sheets(1).Range("a1")
         For i = 2 To s_
             r_ = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row + 1
             With Sheets(i)
                 .Range(.Range("A3"), .Range("A3").SpecialCells(xlLastCell)).Copy Sheets(1).Range("a" & r_)
             End With
         Next
     End If
End Sub

[/vba]

К сообщению приложен файл: 2578515_1.xls (61.5 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

frukti4ek

Дата: Вторник, 21.07.2015, 16:28 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 0 ±

Замечаний: 20% ±

_Boroda_, БОЛЬШОЕ СПАСИБО!!!!!

Девочки из отдела прыгают от счастья )))))

Ответить

Страница 1 из 1
1