bonjour a tous

je suis un peut débutant dans la Vba ,mais voila j arrive m en sortir plus ou moins

ma question est que c'est possible de compressé 4 code Vba en 1 seule

car j ai 4 boutons que je voudrais en faire un seul

j'ai copier mes codes dans l ordre de phase au quel doit être exécuter

si vous avez des techniques ou m expliquer comment faire sa me permettrai d'évoluer dans le codage

ci-joints mes lignes de code

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
 
phase1
 
Sub ExtraireNomsFichier()
 
    Dim ws As Worksheet
    Dim cell As Range
    Dim nomFichier As String
    Dim positionDernierAntiSlash As Integer
    Dim positionDernierPoint As Integer
 
    Set ws = ThisWorkbook.Sheets("Tag_fichiers_dossiers") ' Remplacez "Feuil1" par le nom de votre feuille
 
    For Each cell In ws.Range("B:B") ' Parcourt chaque cellule de la colonne B
        If cell.value <> "" Then ' Vérifie si la cellule n'est pas vide
            nomFichier = cell.value ' Récupère le contenu de la cellule
            ' Trouve la position du dernier anti-slash pour gérer le chemin
            positionDernierAntiSlash = InStrRev(nomFichier, "\")
            ' Trouve la position du dernier point pour gérer l'extension
            positionDernierPoint = InStrRev(nomFichier, "")
 
            If positionDernierAntiSlash > 0 And positionDernierPoint > 0 Then ' Vérifie si les positions sont valides
                ' Extrait uniquement le nom du fichier entre le dernier anti-slash et le dernier point
                cell.Offset(0, -1).value = Mid(nomFichier, positionDernierAntiSlash + 1, positionDernierPoint - positionDernierAntiSlash - 0)
            End If
        End If
    Next cell
End Sub
 
phase 2
 
Sub Copy_de_A_vers_G()
 
    'Déclaration des variables
    Dim ws As Worksheet
    Dim value As String
    Dim cell As Range
 
    'Définition de la feuille de calcul à utiliser
    Set ws = ThisWorkbook.Sheets("Tag_fichiers_dossiers") ' Remplacez "Sheet1" par le nom de votre feuille
 
    'Boucle à travers les cellules de la plage A2:A450 de la feuille de calcul
    For Each cell In ws.Range("A2:A450")
        'Vérifie si le texte de la cellule contient '-' ou '.'
        If InStrRev(cell.value, "-GA.") > 0 Then
            'Si la cellule contient '-', extraire la partie avant '-' dans 'value'
            value = Left(cell.value, InStrRev(cell.value, "-GA.") - 1)
        ElseIf InStrRev(cell.value, ".") > 0 Then
            'Si la cellule contient '.', extraire la partie avant '.' dans 'value'
            value = Left(cell.value, InStrRev(cell.value, ".") - 1)
        Else
            'Sinon, définir 'value' comme la valeur de la cellule
            value = cell.value
        End If
        'Écrire la valeur traitée dans la colonne G de la même ligne que la cellule actuelle
        cell.Offset(0, 6).value = value
    Next cell
 
End Sub
 
Phase 3
 
Sub RemplirColonneF()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
 
    ' Spécifier la feuille de calcul
    Set ws = ThisWorkbook.Sheets("Tag_fichiers_dossiers") ' Remplacez "NomFeuille" par le nom de votre feuille
 
    ' Trouver la dernière ligne avec des données dans la colonne A
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
 
    ' Parcourir chaque ligne avec des données dans la colonne A
    For i = 1 To lastRow
        If InStr(2, UCase(ws.Cells(i, 7).value), "N1") > 0 Then
            ws.Cells(i, 6).value = "Gammes N1\"
        ElseIf InStr(1, UCase(ws.Cells(i, 7).value), "N2") > 0 Then
            ws.Cells(i, 6).value = "Gammes N2\"
        ElseIf InStr(1, UCase(ws.Cells(i, 7).value), "N3") > 0 Then
            ws.Cells(i, 6).value = "Gammes N3\"
        Else
            ' Mettre une valeur par défaut si aucun des mots n'est trouvé
            ws.Cells(2, 6).value = ""
        End If
    Next i
End Sub
 
phase 4
 
Sub repertoire_destination()
    ' Déclarer les variables
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
 
    ' Spécifier la feuille de calcul
    Set ws = ThisWorkbook.Worksheets("Tag_fichiers_dossiers")
 
    ' Trouver la dernière ligne avec des données dans la colonne E
    lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
 
    ' Boucler à travers les lignes avec des données dans la colonne E
    For i = 2 To lastRow
        ' Copier la valeur en colonne C dans la colonne E et concaténer les valeurs
        ws.Cells(i, "C").value = ws.Cells(i, "E").value & ws.Cells(i, "C").value & _
                                  ws.Cells(i, "F").value & ws.Cells(i, "G").value & _
                                  ws.Cells(i, "H").value
 
        ' Cette ligne fusionne les valeurs de colonnes E, F, G, H et C dans la colonne F de la même ligne
    Next i
End Sub