Nombre de Ligne limités

Bonjour,

J'avais demandé de l'aide sur ce Forum et Thautheme m'avait bien aidé. J'ai voulu appliquer le code à un plus grand Fichier ( 3282 Sites, 261 indicateurs) mais ai eu un message d'erreur d'éxecution 6, dépassement de la capacité. Je pense que c'est lié au fait qu'excel ne prend pas plus de 65000 Lignes.
Le code est ci joint et le fichier d'entrée aussi.Quelqu'un aurait une solution s'il vous plait (sachant que le fichier de sorti peut aussi être un csv ou txt) mais doit pouvoir contenir autant de ligne que possible (Nbre de sites x Nbre d'indicateurs)

Merci beaucoup par avance de votre aide.

Fichier d'entrée : https://www.cjoint.com/c/FICiHzdD7uC
Fichier avec la macro: https://www.cjoint.com/c/FICiKq6RDrC

Code:

Sub TransformationKSEN()
Dim OS As Worksheet 'définit la variable OS (Onglet Source)
Dim OD As Worksheet 'définit la variable OD (Onglet Destination)
Dim TV As Variant 'définit la variable TV (Tableau des Valeurs)
Dim I As Integer 'définit la variable I (Incrément)
Dim J As Integer 'définit la variable J (incrément)
Dim LI As Integer 'définit la variable LI (LIgne)
Dim COL As Byte 'définit la variable COL (COLonne)

Set OS = Worksheets(1) 'définit l'onglet source OS (à adapter)
Set OD = Worksheets(2) 'définit l'onglet destination OD (à adapter)
OD.Cells.ClearContents 'efface d'enventuelles anciennes données dans l'onglet destination
OD.Range("A1").Value = "FolderPath" 'étiquette en A1
OD.Range("B1").Value = "Reporting Period (Key #2)" 'étiquette en B1
OD.Range("C1").Value = "Frequency" 'étiquette en C1
OD.Range("D1").Value = "Code (Key #2)" 'étiquette en D1
OD.Range("E1").Value = "Number" 'étiquette en E1
OD.Range("F1").Value = "Text" 'étiquette en F1
OD.Range("G1").Value = "Custom List \ Value" 'étiquette en G1
OD.Range("H1").Value = "Custom List Multiple \ Value" 'étiquette en H1

TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 3 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
    For J = 1 To UBound(TV, 2) - 1 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
        LI = OD.Range("A" & Application.Rows.Count).End(xlUp).Row + 1 'définit la ligne LI
        OD.Cells(LI, 1).Value = "@" & TV(I, 1) 'renvoie le nom du site dans la cellule ligne I, colonne 1 (=A) de OD
        OD.Cells(LI, 2).Value = "01/01/2016"
        OD.Cells(LI, 3).Value = "1"
        OD.Cells(LI, 4).Value = TV(1, J + 1) 'renvoie le nom de l'indicateur dans la cellule ligne LI colonne 2 de OD
        Select Case TV(2, J + 1) 'agit en fonction de la valeur de la donnée ligne 2 colonne J+1 de TV
            Case "Number" 'cas
                COL = 5 'définit la colonne COL
            Case "Text" 'cas
                COL = 6 'définit la colonne COL
            Case "Custom List \ Value" 'cas
                COL = 7 'définit la colonne COL
            Case "Custom List Multiple \ Value" 'cas
                COL = 8 'définit la colonne COL
        End Select 'fin de l'action en fonction de donnée ligne 2 colonne J+1 de TV
        'renvoie dans la cellule ligne LI colonne COL de OD, la donnée ligne I colonne J+1 de TV
        OD.Cells(LI, COL).Value = TV(I, J + 1)
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
OD.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Destination.csv", FileFormat:=xlCSV, CreateBackup:=False
End Sub

{| border="1" style=" border: 1px solid grey;background-color:RebeccaPurple;color:DarkSlateBlue"
|-
| style="background-color:#EFF8FB;border: 1px solid transparent"| EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici :ICI