Macro Boucle Cells Range

Sub test3()
'
' test3 Macro
'

'

Dim MyPath As String  ' le chemin
Dim LgInit As Integer ' la longueur du chemin MyPath
Dim MyName As String  ' l'entrée du repertoire ou le fichier
Dim DossierTransport As String  ' le numero pour créer le dossier
Dim LaDate As Date ' la date du jour
Dim ChaineDate As String 'contient la date en chaine
Dim TempMois As String
Dim TempJour As String
Dim Utilisateur As String ' contient le nom pour créer le PDF
Dim Langue As String  ' contient la langue (2 lettres)
Dim NomFichier As String ' le nomdéfinitif du fichier
Dim NomFichier2 As String ' le nom du fichier pdf Sand à exporter
Dim FeuilleSand As String ' le nom d'onglet --feuille Sand
Dim I As Integer ' compteur

Dim TabLangue(6) As String


TabLangue(0) = "EN"
TabLangue(1) = "FR"
TabLangue(2) = "IT"
TabLangue(3) = "DE"
TabLangue(4) = "ESP"
TabLangue(5) = "LT"


While Langue = ""
Langue = InputBox("choisissez la langue..." & Chr(10) & Chr(10) & "Click sur annuler " & Chr(10) & "pour changer de langue " & Chr(10) & Chr(10) & "....> suivant ", "choix de la langue", TabLangue(I))
I = I + 1
If I > UBound(TabLangue) Then Exit Sub
Wend

LaDate = Format(Date, "yyyy/mm/dd")

TempMois = CStr(Month(LaDate))
If Len(TempMois) < 2 Then TempMois = "0" & TempMois
TempJour = CStr(Day(LaDate))
If Len(TempJour) < 2 Then TempJour = "0" & TempJour
ChaineDate = CStr(Year(LaDate)) + TempMois + TempJour
'***********************************************

Utilisateur = "_pasiulymas_ramundas_"

'***********************************************
' la langue sera gérée dans la boucle


MyPath = ThisWorkbook.Path
MyPath = MyPath + "\PASIULYMAI"

MyName = Dir(MyPath, vbDirectory)
If MyName = "" Then
    MkDir MyPath
End If
ChDir MyPath


Sheets(Langue).Select ' on sélectionne la feuille de la langue
'celle-ci sera exportée 80 fois ou plus
Application.ScreenUpdating = False
For I = 0 To 2000 Step 25
    Sheets(Langue).Range("L18").Value = I 'on place la valeur du transport
    
    'le nom du fichier en sortie devient
    NomFichier = ChaineDate + "_Promotion_Rasmundas_" + Langue
    NomFichier2 = ChaineDate + "_Sand_" + Langue
    
    'je vérifie l'existance du sousrépertoire
    'et s'il n'existe pas il y a création
    'création des 80 ou plus
    DossierTransport = Sheets(Langue).Range("L18").Value  ' ou i

    MyPath = MyPath & "\" & DossierTransport
    
    MyName = Dir(MyPath, vbDirectory)
    If MyName = "" Then
      MkDir MyPath
    End If
    ChDir MyPath ' on se positionne au bon endroit

'if range("L17").value like.... ' note L17 doit être entre crochets
    If Sheets(Langue).Range("L17").Value Like "Transport :" Then
       'en mettant Sh.name le fichier Pdf portera le nom de la feuille

        Sheets(Langue).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyPath & "\" & NomFichier, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        FeuilleSand = Langue + "_Sand"
        Sheets(FeuilleSand).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyPath & "\" & NomFichier2, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        
    End If
    
    MyPath = Mid(MyPath, 1, Len(MyPath) - Len(DossierTransport) - 1)
    LgInit = Len(MyPath)
    'On ajoute le répertoire SANDELYJE
    MyPath = MyPath & "\SANDELYJE"
    MyName = Dir(MyPath, vbDirectory)
    If MyName = "" Then
      MkDir MyPath
    End If
    ChDir MyPath ' on se positionne au bon endroit
    'On ajoute le répertoire SANDELYJE\0 ...2000
    MyPath = MyPath & "\" & I
    MyName = Dir(MyPath, vbDirectory)
    If MyName = "" Then
      MkDir MyPath
    End If
    ChDir MyPath ' on se positionne au bon endroit
    'on peut ajouter une feuille Ici
    
        Sheets(Langue).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyPath & "\" & NomFichier, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        
        Sheets(FeuilleSand).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyPath & "\" & NomFichier2, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    'on revient à la racine
    MyPath = Left(MyPath, LgInit)
    ChDir (MyPath)
    
    
Next
Application.ScreenUpdating = True
Sheets(Langue).Select
End Sub