Temat: Zestawienie wielu arkuszy w jeden - Makro, pętla

Witam,

mam problem z utworzeniem makra które pozwoliłoby mi stworzyć zestawienie wielu arkuszy w jednym podsumowywującym.
- Każdy z arkuszy wyglądałby pod względem strukturalnym tak samo
- Różniłaby się ilość pozycji i oczywiście ich nazwy

W załączniku plik excel z moją dotychczasową pracą, starałem się stworzyć makro z rejestru dla pierwszej pozycji z pierwszego arkusza po czym jakoś zapętlić zakres zaznaczenia by wykonywało operacje tyle razy ile jest pozycji, niestety po wielu próbach nie udało się.
- Dokładniejsze opisy o co mi chodzi dokładniej są zawarte w kodzie makra w załączniku

Pozdrawiam i z góry dziękuję

Link do pliku Excel: http://przeklej.org/file/8QVgfb/Nowy.Arkusz.programu.M...

gdyby makro nie było widoczne w pliku:

Sub Import()
'
' Import Makro
'

'Wkjejenie nagłówka tabeli

Sheets("Protokół 1").Select
Range("A1:E1").Select
Selection.Copy
Sheets("Zestawienie").Select
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'Zaznaczenie pierwszego wiersza tabeli oraz jego wklejenie w arkuszu Zestawienie oraz stworzenie ramki

'Chodzi o zapętlenie tego kodu by powtarzał się dopóki będą dane w protokole,
'gdyż czasami jest np. 100 pozycji a w kolejnym protokole np 20
'Chodzi również o zapętlenie tej czynności dla kolejnych protokołów - będą się nazywały tak jak we wzorze
'może być ich dużo, więc również jakaś pętla

'Idealnie by było gdyby wyrzucało jeszczę nazwę arkusza z którego pobrane zostały dane, tak jak to widać w
'arkuszu Zestawnienie koniec

'Poniższy kod jest tylko dla zaznaczonego obszaru oraz dla Protokół 1

Range("A3").Select
Sheets("Protokół 1").Select
Range("A2:E2").Select
Selection.Copy
Sheets("Zestawienie").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub

Temat: Zestawienie wielu arkuszy w jeden - Makro, pętla

Miejsce na jakim umieściłeś plik zgłasza się jako niezaufane.
niestety nagrywarka kodu nie zawsze spełni oczekiwania, ponieważ nie uczy jak wykonac pętle czy deklarować zmienne.
Jeśli potrzebujesz coś bardziej profesjonalnego, na już i bez porad z których nie wiążesz przyszłosci to polecam takie rozwiązania: