Собрать данные с разных листов в один и добавить имена листов

[Ксения Курбетьева]

Уважаемые коллеги, добрый день. Есть потребность в регулярном сборе данных с разных листов в один - все таблицы имеют одну форму, отличаются только данные. Но при этом необходимо, чтобы в итоговой таблице был дополнительный столбец - с какого листа забраны данные.
Прикрепляю пример.
Хотела воспользоваться записью макроса, но количество строк каждый раз во входных данных разница.
Как скорректировать под данную задачу следующий макрос?

Код Выделить Развернуть

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

Или написать новый?

[NooBasTiK]

Я пользуюсь надстройкой MyAddin для Excel там есть такая функция

[Ксения Курбетьева]

К сожалению, такой надстройки у меня нет, как это можно сделать с помощью макросов?

[gling]

Посмотрите здесь готовый макросhttp://www.excel-vba.ru/chto-umeet-excel/kak-sobrat-dannye-s-neskolkix-listov-ili-knig/

[ShAM]

Так подойдет?
ЗЫ: Странно, только узнал, что .xlsm прилеплять нельзя
На всякий случай, код тоже выложу:

Код Выделить Развернуть

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_)
    Range("d" & r_) = Sheets(i).Name
Next
    r_ = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row
    Range("d2:d" & r_).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    Range("d2:d" & r_).Value = Range("d2:d" & r_).Value
End If
End Sub

[Ксения Курбетьева]

ShAM
вы прекрасны! Спасибо огромное - то, что нужно) поправила только колонку в коде (ибо нужно было, не d, а T)