Unir diferents fulls Excel en un únic full (2)

Una mica millorat fent servir constants per no oblidar-nos de dimensionar el número de fulls afectats i el número de línies a tractar. En aquest cas treballem amb 13 pàgines i la pàgina que té més línies té unes 30.

El codi:

Option Explicit
Dim MyNumPage As String
Dim MyRange As String
Dim NumeracioMyNumPage As Byte
Dim NumeracioMyRange  As String
Dim i As Byte
'Aqui declarem com a constant el número pàgines a tractar
'############################
Const TotalPage As Byte = 13
'Aqui declarem com a constant el número de línies a tractar
'############################
Const TotalLines As Byte = 30

Sub CopiarYPegar()

'Començarem a la segona línia: -(30-2) = -28
NumeracioMyRange = -(TotalLines - 2)
i = 1
For i = 1 To TotalPage
    NumeracioMyNumPage = i
        If i < 10 Then
            MyNumPage = "Page00" & NumeracioMyNumPage
        Else
            MyNumPage = "Page0" & NumeracioMyNumPage
        End If
    Parche_01
Next i
End Sub

Sub Parche_01()
    Sheets(MyNumPage).Select
    ActiveSheet.Range("A2:P" & TotalLines).Select
    Selection.Copy
    Sheets("Hoja1").Select
    NumeracioMyRange = NumeracioMyRange + TotalLines
    MyRange = "B" & NumeracioMyRange
    Range(MyRange).Select
    ActiveSheet.Paste
End Sub

#####################

Cal destacar la forma de fer referéncia a un rang fent servir una constant:

    ActiveSheet.Range("A2:P" & TotalLines).Select