Simplification de Macros

Version imprimable

1 pièce(s) jointe(s)

Pièce jointe 153569

Re bonjour le Forum,

Je cherche à simplifier ces macros dans le module 2

Qui peut m'aider, svp ?

Bonne aprem.

Seb

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
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:

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:

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:

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:

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:

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

Une façon de faire pour la première

Code:

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

12/08/2014, 21h41
GADENSEB

C'est génial comme code !
Est-ce que l'on peut l'appliquer aux autres codes ?
12/08/2014, 21h53
parmi

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é.

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:

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:

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

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:

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
Donc arrControls(0) aura la colonne de recherche de arrColonnes(0) et ainsi de suite...

Pour ton deuxième cas

Code:

For Each Lien In .UsedRange.Hyperlinks

14/08/2014, 09h30
GADENSEB

merci !
Je vais me pencher là dessus !

Bonne journée
Seb