Simplification de Macros

**GADENSEB** · 12/08/2014, 16h42

BASE EMPLOI - DEMO.xls

Re bonjour le Forum,

Je cherche à simplifier ces macros dans le module 2

Qui peut m'aider, svp ?

Bonne aprem.

Seb

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub CONVERTIRFORMATS()
 
    'Convertir en format DATE
Worksheets("BASE EMPLOI").Select
 
 
         Range("T65536").End(xlUp).Select
   Selection.TextToColumns Destination:=Range("T2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
      Selection.NumberFormat = "dd/mm/yy"
 
        Range("U65536").End(xlUp).Select
   Selection.TextToColumns Destination:=Range("U2"), DataType:=xlFixedWidth, _
     FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
             Selection.NumberFormat = "dd/mm/yy"
 
        Range("AB65536").End(xlUp).Select
   Selection.TextToColumns Destination:=Range("AB2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
          Selection.NumberFormat = "dd/mm/yy"
 
        Range("AJ65536").End(xlUp).Select
  Selection.TextToColumns Destination:=Range("AJ2"), DataType:=xlFixedWidth, _
   FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
            Selection.NumberFormat = "dd/mm/yy"
 
        Range("AK65536").End(xlUp).Select
Selection.TextToColumns Destination:=Range("AK2"), DataType:=xlFixedWidth, _
 FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
       Selection.NumberFormat = "dd/mm/yy"
 
         Range("AL65536").End(xlUp).Select
Selection.TextToColumns Destination:=Range("AL2"), DataType:=xlFixedWidth, _
      FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
               Selection.NumberFormat = "dd/mm/yy"
 
        Range("AM65536").End(xlUp).Select
Selection.TextToColumns Destination:=Range("AM2"), DataType:=xlFixedWidth, _
      FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
               Selection.NumberFormat = "dd/mm/yy"
 
         Range("AT65536").End(xlUp).Select
   Selection.TextToColumns Destination:=Range("AT2"), DataType:=xlFixedWidth, _
       FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
          Selection.NumberFormat = "dd/mm/yy"
 
      Range("BB65536").End(xlUp).Select
  Selection.TextToColumns Destination:=Range("BB2"), DataType:=xlFixedWidth, _
      FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
           Selection.NumberFormat = "dd/mm/yy"
 
 
 
 
 
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub CONVERTIRDATES()
Worksheets("BASE EMPLOI").Select
   Range("T2:T1500").Select
    Selection.TextToColumns Destination:=Range("T2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
    Range("U2:U1500").Select
    Selection.TextToColumns Destination:=Range("U2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
    Range("AB2:AB1500").Select
    Selection.TextToColumns Destination:=Range("AB2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
    Range("AJ2:AJ1500").Select
    Selection.TextToColumns Destination:=Range("AJ2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
        Range("AK2:AK1500").Select
    Selection.TextToColumns Destination:=Range("AK2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
         Range("AL2:AL1500").Select
    Selection.TextToColumns Destination:=Range("AL2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
        Range("AM2:AM1500").Select
    Selection.TextToColumns Destination:=Range("AM2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
        Range("AU2:AU1500").Select
    Selection.TextToColumns Destination:=Range("AT2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
         Range("BB2:BB1500").Select
    Selection.TextToColumns Destination:=Range("BA2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
 
 
End Sub

'======= DEFINIT LA ZONE D'IMPRESSION =============

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub ZONEIMPRESSION()
Worksheets("BASE EMPLOI").Select
'Détermine la zone d'impression
 
ActiveSheet.PageSetup.PrintArea = Range("A1:BB" & _
Range("A65536").End(xlUp).Row).Address
 
End Sub

'============ CHANGE LA COULEUR DES COLONNES SOMMAIRES =========

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Sub COULEURCOLONNES()
 
Worksheets("BASE EMPLOI").Select
    ' Trait du bas sur toutes les lignes
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A2").Select
 
 
    ' Pas de trait sur les colonnes sommaires
 
    Range("F:F").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    Range("M:M").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    Range("S:S").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    Range("Z:Z").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    Range("AE:AE").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    Range("AR:AR").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
    Range("A1").Select
 
    ' Copie les couleurs des colonnes
    Range("F3").Select
    Selection.AutoFill Destination:=Range("F3:F1500"), Type:=xlFillDefault
    Range("F3:F1500").Select
 
    Range("M3").Select
    Selection.AutoFill Destination:=Range("M3:M1500"), Type:=xlFillDefault
    Range("M3:M1500").End(xlUp).Select
 
    Range("S3").Select
    Selection.AutoFill Destination:=Range("S3:S1500"), Type:=xlFillDefault
    Range("S3:S1500").End(xlUp).Select
 
    Range("Z3").Select
    Selection.AutoFill Destination:=Range("Z3:Z1500"), Type:=xlFillDefault
    Range("Z3:Z1500").End(xlUp).Select
 
    Range("AE3").Select
    Selection.AutoFill Destination:=Range("AE3:AE1500"), Type:=xlFillDefault
    Range("AE3:AE1500").End(xlUp).Select
 
 
    Range("AR3").Select
    Selection.AutoFill Destination:=Range("AR3:AR1500"), Type:=xlFillDefault
    Range("AR3:AR1500").End(xlUp).Select
 
 
 
    Range("A2").Select
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
Sub CENTURYGOTHIC8()
Worksheets("BASE EMPLOI").Select
'Met en Century Gothics 8
    Cells.Select
    With Selection.Font
        .Name = "Century Gothic"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Century Gothic"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("B2").Select
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
Sub MFCATRAITER()
' Mise en forme conditionnelle "A TRAITER"
Worksheets("BASE EMPLOI").Select
    ActiveWindow.SmallScroll Down:=-12
    Range("B65536").End(xlUp).Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="A TRAITER", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 90
        .Gradient.ColorStops.Clear
    End With
    With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0.5)
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
 
 
 
End Sub

**parmi** · 12/08/2014, 20h05

Une façon de faire pour la première

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub MacroX()
    Dim arrColonnes As Variant
    arrColonnes = Array("T", "U", "AB", "AJ", "AK", "AL", "AM", "AT", "BB")
    CONVERTIRFORMATS arrColonnes
End Sub
 
Sub CONVERTIRFORMATS(arrColonne As Variant)
    Dim I As Long, nbLignes As Long
 
    'Convertir en format DATE
    Sheets("BASE EMPLOI").Activate
 
    For I = 0 To UBound(arrColonne)
        nbLignes = Cells(Rows.Count, arrColonne(I)).End(xlUp).Row
        Range(Cells(2, arrColonne(I)), Cells(nbLignes, arrColonne(I))).Select
        Selection.TextToColumns Destination:=Cells(2, arrColonne(I)), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
        Selection.NumberFormat = "dd/mm/yy"
    Next
 
End Sub

**GADENSEB** · 12/08/2014, 21h41

C'est génial comme code !
Est-ce que l'on peut l'appliquer aux autres codes ?

**parmi** · 12/08/2014, 21h53

Sur le même principe, tu peux refaire la 2e macro: CONVERTIRDATES
en te servant du même Array.

Pour les autres, je n'ai pas tout regardé, mais dès qu'il y a redondance dans le code, tu peux grouper en bouclant, ce qui allège le nombre de lignes de code et la lisibilité.

**GADENSEB** · 13/08/2014, 08h22

Ca marche je vais étudié le truc

du coup est-ce qu'il y a moyen de réduire ce code ?
Dans l'onglet GESTION

Pour info, il faut cliquer dans une des cellules a36:h90 pour que l'usf GESTIONPOSTE s'ouvre grâce au code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
'================================== OUVERTURE GESTION POSTE =================================
 
'Génére l'userform POSTE en cliquant sur le CODE
   On Error Resume Next
  ' Function link(c As Range)
 Dim j&
    j = Range("I36").End(xlDown).Row
    If Target.Row <= j And Target.Row >= 36 Then
 
        nNumeroDeLigne = Application.WorksheetFunction.Match(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:a2000"), 0)
 
        GESTIONPOSTE.CODEBASE = Cells(Target.Row, "I").Value
 
 
 
        GESTIONPOSTE.USER = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 2, False)
 
        GESTIONPOSTE.SOCIETE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 3, False)
 
 
        GESTIONPOSTE.ZONE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 4, False)
        GESTIONPOSTE.TYPESOCIETE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 5, False)
        GESTIONPOSTE.NOMCONTACT = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 7, False)
        GESTIONPOSTE.PRENOMCONTACT = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 8, False)
        GESTIONPOSTE.FONCTIONCONTACT = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 9, False)
        GESTIONPOSTE.TELEPHONECONTACT = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 10, False)
        GESTIONPOSTE.PORTABLECONTACT = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 11, False)
        GESTIONPOSTE.MAILCONTACT = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 12, False)
        GESTIONPOSTE.ADRESSESCOCIETE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 14, False)
        GESTIONPOSTE.CPSOCIETE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 16, False)
        GESTIONPOSTE.VILLESOCIETE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 17, False)
        GESTIONPOSTE.SITESOCIETE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 18, False)
 
 
        GESTIONPOSTE.DATEINSCRIPTION = Worksheets("BASE EMPLOI").Cells(nNumeroDeLigne, 20)
        GESTIONPOSTE.DATEMAJ = Worksheets("BASE EMPLOI").Cells(nNumeroDeLigne, 21)
        GESTIONPOSTE.DATEANNONCE = Worksheets("BASE EMPLOI").Cells(nNumeroDeLigne, 36)
        GESTIONPOSTE.DATEREPONSE = Worksheets("BASE EMPLOI").Cells(nNumeroDeLigne, 37)
        GESTIONPOSTE.RELANCE = Worksheets("BASE EMPLOI").Cells(nNumeroDeLigne, 38)
        GESTIONPOSTE.DATERETOUR = Worksheets("BASE EMPLOI").Cells(nNumeroDeLigne, 39)
 
 
        GESTIONPOSTE.LOGIN = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 22, False)
        GESTIONPOSTE.MDP = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 23, False)
        GESTIONPOSTE.ANNONCESBYMAIL = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 24, False)
        GESTIONPOSTE.COMMENTAIRES = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 25, False)
 
        GESTIONPOSTE.POSTE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 32, False)
        GESTIONPOSTE.CONTRAT = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 33, False)
        GESTIONPOSTE.LIEU = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 34, False)
        GESTIONPOSTE.REMUNERATION = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 35, False)
 
 
 
        GESTIONPOSTE.TEXTECANDIDATURE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 40, False)
        GESTIONPOSTE.ANNONCE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 40, False)
        GESTIONPOSTE.COMMENTAIRESCANDIDATURE = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 41, False)
        GESTIONPOSTE.NBENTRETIENS = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 46, False)
        GESTIONPOSTE.CRENTRETIENS = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), 52, False)
 
 
        GESTIONPOSTE.Show
 
    End If
 
 
End Sub

Par contre je rame pour celle la :

Je n'arrive pas à trouver ou mettre les "." pour faire comme dans le premier exemple.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
sub LIENHYPERTEXTEMODIF()
With Sheets("BASE EMPLOI")
Dim Lien As Hyperlink
Dim AncienTexte As String
Dim NouveauTexte As String
 
AncienTexte = "C:\Users\SEBASTIEN GADEN\AppData\Roaming\Seb Personnel\TRAVAIL\ANNONCES REPONDUES\"
NouveauTexte = "T:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"
 
For Each Lien In ThisWorkbook.Sheets("BASE EMPLOI").UsedRange.Hyperlinks
   Lien.Address = Replace(Lien.Address, AncienTexte, NouveauTexte)
Next
End With
End Sub

**parmi** · 13/08/2014, 15h02

Pour ton premier code, tu peux ajouter un With GESTIONPOSTE et enlever la mention sur toutes les lignes

Pour les formules qui sont identiques sauf le nom du contrôle et la colonne de recherche, tu pourrais faire une boucle en utilisant 2 tableaux:
1 pour les noms de contrôles
1 pour les colonnes de recherche

Voici un court exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 Dim I As Long
 Dim arrControls
 Dim arrColonnes
 
 arrControls = Array("USER", "SOCIETE", "ZONE", "TYPESOCIETE") 'mettre tous les contrôles ayant le même type de formule
 arrColonnes = Array(2, 3, 4, 5)'mettre tous les numéros de colonne de recherche dans le même ordre que les contrôles
 
    j = Range("I36").End(xlDown).Row
    If Target.Row <= j And Target.Row >= 36 Then
    
        nNumeroDeLigne = Application.WorksheetFunction.Match(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:a2000"), 0)
    
With GESTIONPOSTE
    For I = 0 To UBound(arrControls)  'boucle toutes les mêmes formules
        .Controls("" & arrControls(I) & "") = Application.VLookup(Cells(Target.Row, "I").Value, Worksheets("BASE EMPLOI").Range("A1:BB2000"), arrColonnes(I), False)
    Next