Рабочий макрос для собирания листов книги Excel. Нужно, например, для спецификаций Fujitsu и Huawei.
Открываем файл со спекой, вызываем по Alt + F11 VBA надстройку, во вкладке Incert добавляем Module и в него вбиваем:
Sub pp()
Application.ScreenUpdating = False
Dim sh As Worksheet
Dim shItog As Worksheet
Dim iL As Long, iL2 As Long
Set shItog = Sheets("Itog")
For Each sh In Worksheets
If sh.Name <> shItog.Name Then
iL = sh.Cells(Rows.Count, 1).End(xlUp).Row
iL2 = shItog.Cells(Rows.Count, 1).End(xlUp).Row + 2
sh.Range(sh.Cells(1, 1), sh.Cells(iL, 10)).Copy shItog.Cells(iL2, 1)
End If
Next sh
Application.ScreenUpdating = True
End Sub
перед запуском удаляем вручную ненужные листы, если такие есть и добавляем один чистый лист с именем Itog, после этого Run Macro (F5).
Могут вылезать ошибки, например, если листы имели одинаковые метаданные в поле (Name).
Открываем файл со спекой, вызываем по Alt + F11 VBA надстройку, во вкладке Incert добавляем Module и в него вбиваем:
Sub pp()
Application.ScreenUpdating = False
Dim sh As Worksheet
Dim shItog As Worksheet
Dim iL As Long, iL2 As Long
Set shItog = Sheets("Itog")
For Each sh In Worksheets
If sh.Name <> shItog.Name Then
iL = sh.Cells(Rows.Count, 1).End(xlUp).Row
iL2 = shItog.Cells(Rows.Count, 1).End(xlUp).Row + 2
sh.Range(sh.Cells(1, 1), sh.Cells(iL, 10)).Copy shItog.Cells(iL2, 1)
End If
Next sh
Application.ScreenUpdating = True
End Sub
перед запуском удаляем вручную ненужные листы, если такие есть и добавляем один чистый лист с именем Itog, после этого Run Macro (F5).
Могут вылезать ошибки, например, если листы имели одинаковые метаданные в поле (Name).