Simplification de la macro

Version imprimable

Bonjour,

Je viens vers vous car j'ai créer une macro pour le travail qui fonctionne très bien.
Mon soucie est que ma macro a atteint ses limites, j'ai ajouter une ligne et lorsque je lance la macro j'ai un message me disant que la macro est trop longue.

Je pense qu'il y a un moyen de simplifier l'ensemble mais mes connaissance en VBA étant assez limité je ne sais pas comment faire.

Je vous mets un bout de code pour vous donner une idée de ce que j'utilise pour le moment.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub creation_dossier_AB()
On Error Resume Next
Dim lig As Byte
lig = Range("A65536").End(xlUp).Row
 
 
    If Cells(ActiveCell.Row, 13) = "Paris" Then
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\PARIS_75\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8)
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\PARIS_75\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\ETUDE_TVX"
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\PARIS_75\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\FINANCIER"
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\PARIS_75\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\RECEPTION"
 
    ElseIf Cells(ActiveCell.Row, 13) = "Strasbourg" Then
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\STRASBOURG_67\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8)
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\STRASBOURG_67\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\ETUDE_TVX"
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\STRASBOURG_67\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\FINANCIER"
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\STRASBOURG_67\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\RECEPTION"
 
    ElseIf Cells(ActiveCell.Row, 13) = "Nantes" Then
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\NANTES_44\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8)
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\NANTES_44\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\ETUDE_TVX"
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\NANTES_44\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\FINANCIER"
    MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\NANTES_44\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\RECEPTION"
 
    End If
 
End Sub

Merci d'avance à ceux qui pourrons m'aider.

Florent

Bonsoir

A tout hasard

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub creation_dossier_AB()
Dim LastLig As Long, i As Long
Dim Villes(), Codes()
Dim Chemin As String, Tmp As String
Dim j
 
Villes = Array("paris", "strasbourg", "nantes")
Codes = Array(75, 67, 44)
Chemin = "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\|_@\09_TRAVAUX\" & "DV"
With Feuil1
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To LastLig
        j = Application.Match(.Cells(i, 1).Value, Villes, False)
        If Not IsError(j) Then
            j = j - 1
            Tmp = Replace(Chemin, "|", UCase(Villes(j)))
            Tmp = Replace(Tmp, "@", UCase(Codes(j))) & .Cells(i, 8)
 
            MkDir Tmp
            MkDir Tmp & "\ETUDE_TVX"
            MkDir Tmp & "\FINANCIER"
            MkDir Tmp & "\RECEPTION"
        End If
    Next i
End With
End Sub

15/03/2019, 23h29
Florent6744

Bonjour,

Merci pour ton aide.
Juste pour savoir lorsqu'on utilise array, y a t'il une limite car j'ai environ 120 villes a mettre.

Je viens de tester et ça ne fonctionne pas.... pour une bonne raison mon exemple n’était pas assez précis.

Je m'explique, l’écriture du nom de la commune en colonne 13 n'ai pas forcément le même que sur la ligne d'adresse du dossier (pardon si je n'utilise pas les bons termes)
exemple:
Code:

1 2 3 4 5 If Cells(ActiveCell.Row, 13) = "Bourg en Bresse" Then MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\BOURG_EN_BRESSE_025\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\BOURG_EN_BRESSE_025\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\ETUDE_TVX" MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\BOURG_EN_BRESSE_025\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\FINANCIER" MkDir "Y:\01_DOSSIERS ACTIFS\07_MAINTENANCE_EP\06_GESTION 2017_2020\01_COLLECTIVITES\02_COMMUNES\BOURG_EN_BRESSE_025\09_TRAVAUX\" & "DV" & Cells(ActiveCell.Row, 8) & "\RECEPTION"
et pour faciliter la chose le chiffre apres le nom de ville est obligatoirement sur trois chiffres.

15/03/2019, 23h57
mercatog

Au lieu d'un array on peut utiliser une liste de villes sur une feuille. C'est plus aisé
Pour le nom des villes on peut facilement remplacer les espaces ou apostrophes par _

L'exemple donnée est pour te montrer une démarche