Добрый вечер, друзья =)
Дабы не дать теме умереть, возник один вопрос по макросам
Есть файл с 10-ю абсолютно одинаковыми таблицами, которые заполняют 10 чел + в нем есть скрытые листы. В каждом из 10-ти листов шапка (кол-во столбцов) одинаковая, а вот кол-во строк может быть разное, какое угодно. Нужно сделать итоговую таблицу, с такой же шапкой и чтобы все строки со всех листов перенеслись в Итоговый лист.
Я нашла вот такой макрос. Он прекрасно работает, кроме одного нюанса, он переносит данные в Итоговый лист со скрытых листов, чего делать не нужно)))
Ну и сам вопрос, а как мне переделать этот макрос, чтобы он переносил данные только с конкретных листов, а не со всех?
Вот сам макрос
Sub Start()
Call CreateSheet
Call Copy
End Sub
Private Sub CreateSheet()
`Если лист итог существует, то он удаляется и заново создается
On Error Resume Next
Set wsSheet = Sheets("итог")
If Err.Number = 0 Then
Application.DisplayAlerts = False
Sheets("итог").Delete
Application.DisplayAlerts = True
End If
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "итог"
End Sub
Private Sub Copy()
Dim sRng As Range 'что копируем
Dim dRng As Range 'куда копируем
Application.ScreenUpdating = False
' вставка шапки на последний лист
ThisWorkbook.Sheets(1).Activate
Set sRng = Range("A1:AW3")
ThisWorkbook.Sheets(Sheets.Count).Activate
Set dRng = Range("A1")
sRng.Copy dRng
'копирование данных на лист Итог
For i = 1 To ThisWorkbook.Sheets.Count - 1
ThisWorkbook.Sheets(i).Activate
Set sRng = Range(Cells(4, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
ThisWorkbook.Sheets(Sheets.Count).Activate
Set dRng = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
sRng.Copy dRng
Next i
Application.ScreenUpdating = True
End Sub