[XL-2010] recherhe et remplacement automatiquemet dans 100 classeurs

[kaynan888]

bonjour génies


voila j ai 100 classeur et je cherche une méthode automatique qui me permet de rechercher et remplacer dans les 100 feuilles.

les 100 classeur sont stockes sur le même répertoire et ils ont la même forme xxxx/xx/xx. la modification sera dans une seule colonne (g).

j'explique mieux la colonne g est remplisse par des noms (michel;anas;zara;nike;........) ces noms se répètent dans les 100 classeur,donc pour rechercher et remplacer je dois ouvrir les 100 feuilles et faire rechercher remplacer.....................
exemple je veux remplacer zara par franca dans ces 100 feuilles mais avec un seul clik (mot a chercher : zara
mot a remplacer: franca
puis il me donne le chemin de dossier qui regroupe ces 100 classeurs ensuite les replacer dans tous les feuilles.
je serais la pour toute explication.

[mercatog]

Bonjour
Ça risque d'être long de:
Ouvrir les 100 fichiers un par un
Boucler sur toutes les feuilles de chaque fichier
Remplacer le texte en colonne G
Enregistrer et fermer chaque fichier

Néanmoins, ci-joint proposition:

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
Sub ModifierLibelle()
Dim OldLibelle As String, NewLibelle As String, Rep As String, Fichier As String
Dim k As Integer
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets(1)
    OldLibelle = .Range("D5").Value
    NewLibelle = .Range("D6").Value
End With
If OldLibelle = "" Or NewLibelle = "" Then
    MsgBox "Saisie obligatoire en D5 et D6"
Else
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count > 0 Then
            Rep = .SelectedItems(1)
            Fichier = Dir(Rep & "\*.xls*")
            Application.DisplayAlerts = False
            Application.AskToUpdateLinks = False
            Do While Fichier <> ""
                k = k + 1
                Call FindReplace(Rep & "\" & Fichier, OldLibelle, NewLibelle)
                Fichier = Dir
            Loop
            Application.DisplayAlerts = True
            Application.AskToUpdateLinks = True
        Else
            MsgBox "Opération annulée par l'utilisateur."
            Exit Sub
        End If
    End With
    MsgBox "Traitement terminé pour " & k & " fichier(s)."
End If
End Sub
 
'Ici on va ouvrir les fichiers, boucler sur toutes les feuilles et remplacer le texte
Private Sub FindReplace(Fich As String, ByVal Anc As String, Nouv As String)
Dim Wbk As Workbook
Dim Sh As Worksheet
 
Set Wbk = Workbooks.Open(Fich)
For Each Sh In Wbk.Worksheets
    Sh.Range("G:G").Replace Anc, Nouv, xlPart
Next Sh
Wbk.Close True
Set Wbk = Nothing
End Sub

Par contre, si pour chaque fichier tu as une seule feuille où remplacer le texte, la procédure FindReplace peut être simplifiée comme ceci:

Code :

1
2
3
4
5
6
7
8
Private Sub FindReplace(Fich As String, ByVal Anc As String, Nouv As String)
Dim Wbk As Workbook
 
Set Wbk = Workbooks.Open(Fich)
Wbk.Worksheets(1).Range("G:G").Replace Anc, Nouv, xlPart
Wbk.Close True
Set Wbk = Nothing
End Sub