EXCEL transposer quand grande taille tableau

Const cel_dep As String = "A1"
Const cel_but As String = "B2"
Const sh_dep As String = "feuil1"
Const sh_but As String = "feuil2"
'
Sub big_transpose()
Dim lig As Long, cptr2 As Long
Dim col As Long, cptr1 As Long

Application.ScreenUpdating = False

tablo = Sheets(sh_dep).Range(cel_dep).CurrentRegion

Sheets(sh_but).Activate
    lig = Range(cel_but).Row - 1
    col = Range(cel_but).Column - 1
    For cptr1 = 1 To UBound(tablo, 1)
        For cptr2 = 1 To UBound(tablo, 2)
            Cells(lig + cptr2, col + cptr1) = tablo(cptr1, cptr2)
        Next cptr2
    Next cptr1
    
End Sub

Sub CopieTransposee() 
    Sheets("Feuil1").Range("B3:L36").Copy 
    Sheets("Feuil3").Range("B3").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ 
        , Transpose:=True 
End Sub

Sub Copie_liaison()
Dim dep As Range
Dim but As Range
Dim lgd As Long, lgb As Long
Dim cld As Long, clb As Long
Set dep = Sheets("Feuil3").Range("A1")  ' début plage à transposer
Set but = Sheets("Feuil2").Range("B15") ' début plage transposée
For lgd = dep.Row To dep.Offset(Columns(1).Cells.Count - dep.Row).End(xlUp).Row
    lgb = 0
    For cld = dep.Column To dep.Offset(0, Rows(1).Cells.Count - dep.Column).End(xlToLeft).Column
        but.Offset(lgb, clb).Formula = "='" & dep.Worksheet.Name & "'!" & dep.Offset(lgd - 1, cld - 1).Address
        lgb = lgb + 1
    Next cld
    clb = clb + 1
Next lgd
End Sub

'cellule départ tableau( "saison") 
Const dep As String * 2 = "A1" 
'adresse depart restitution (feuille2) 
Const rest As String * 2 = "B2" 

Sub phyto_par_saison() 
Dim lig As Byte, col As Byte, dercol As Byte 

With Sheets(1) 
    lig = .Range(dep).Row 
    col = .Range(dep).Column 
    dercol = .Cells(lig, 255).End(xlToLeft).Column 
End With 
Application.sreenupdating = False 
Sheets(2).Range(rest).Resize(4, dercol) = Application.Transpose(Sheets(1).Range(Cells(lig, col), Cells(4, dercol)).Value) 
End Sub