Sub dsd()
Dim Sh As Worksheet
Dim i As Long
For Each Sh In Worksheets 'цикл по листам (переходим каждый лист по очереди)
NL = Sh.Name ' перебирая лист узнаем его имя
If NL <> "Свод" Then ' проверяем имя листа- что бы оно не было равно "СВОД"
    LR = Worksheets(NL).Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю заполненную строку в выбранном листе по первому столбцу
    LCol = Worksheets(NL).Cells(2, Columns.Count).End(xlToLeft).Column 'определяем последний заполненный столбец в выбранном листе по 2 строке
    For i = 3 To LR 'цикл по строкам выбранного листа
    LR2 = Worksheets("Свод").Cells(Rows.Count, 1).End(xlUp).Row + 1 'Определяем последнюю пустую строку в листе СВОД - что-бы вставить данные
    Worksheets(NL).Activate 'активируем лист с которого копируем
    Worksheets(NL).Range(Cells(i, 1), Cells(i, LCol)).Copy ' копируем данные согалсно ранее определенным номеру строки и столбца
    Worksheets("Свод").Range("A" & LR2).PasteSpecial 'вставляем в конец данных (1 пустую строку)
    Next i
End If
Next Sh
 Worksheets("Свод").Select
End Sub