Новости:

Прикрепить к сообщению можно только файлы xls, gif, jpg, rar, zip,7z, bas, frm, cls, doc размером до 150 Кб.

Главное меню

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

Автор Ксения Курбетьева, 29.04.2015, 13:50

« назад - далее »

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

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

mail: vovik100661@gmail.com;
ЯД-41001506838083.

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)