Il y a un peu plus de 200 fichiers (pas 20 comme je l ai mentionné) et plusieurs mots doivent etre changésBonjour @DavidMM, le fil
Suggestion
On peut toujours les ouvrir(*) pour ce faire mais sans qu'ils s'affichent à l'écran
(Surtout si il n'y a que 20 classeurs)
(*) avec une macro qui fera en même temps le remplacement.
Sub test_replace()
Dim Chemin$, fn$, ws As Worksheet, tablo
Chemin = "C:\Users\STAPLE\Documents\TEST_REPLACE\" 'Changer ici
tablo = Array(Array("Chien", "Chat"), Array("Table", "Chaise"))
fn = Dir(Chemin & "*.xlsx")
Application.ScreenUpdating = False
Do While fn <> ""
With Workbooks.Open(Chemin & fn)
For Each ws In .Worksheets
For Each el In tablo
ws.Cells.Replace el(0), el(1), xlPart, , True
Next
Next
.Close True
End With
fn = Dir
Loop
End Sub
Comment l'incorporer ?Re
Un exemple issu de mes archives
Ici on traite des classeurs *.xlsx
Ici on remplace Chien par Chat et Table par Chaise
NB: je viens de faire le test sur 5 classeursCode:Sub test_replace() Dim Chemin$, fn$, ws As Worksheet, tablo Chemin = "C:\Users\STAPLE\Documents\TEST_REPLACE\" 'Changer ici tablo = Array(Array("Chien", "Chat"), Array("Table", "Chaise")) fn = Dir(Chemin & "*.xlsx") Application.ScreenUpdating = False Do While fn <> "" With Workbooks.Open(Chemin & fn) For Each ws In .Worksheets For Each el In tablo ws.Cells.Replace el(0), el(1), xlPart, , True Next Next .Close True End With fn = Dir Loop End Sub
Le remplacement est bien effectué.
A voir/adapter et tester dans ta configuration.
Sinon voir du côté de ADO.
Fichier dans le même répertoire.Bonsoir,
Avec ado c'est possible si la structure des onglets le permet !
Les fichiers sont dans le même répertoire ?
Les onglets sont connus ?
Et où il faudrait un exemplaire anonymisé!
Staple à dit:(message#3)
Sinon voir du côté de ADO.
Staple à dit:(message#6)
Il faudrait un exemple anonymisé
Bonsoir,
Avec ado c'est possible si la structure des onglets le permet !
Les fichiers sont dans le même répertoire ?
Les onglets sont connus ?
Et où il faudrait un exemplaire anonymisé!
Sub test_replace_II()
Dim Chemin$, fn$, ws As Worksheet, tablo
Chemin = "C:\Users\STAPLE\Documents\TEST_REPLACE\" 'Changer ici
tablo = Array(Array("Securité2", "Sécurité pompier 2"), Array("Gardien 2 Paris 75 013", "Gardien Alex Paris 75 013"), Array("Stagiaire 5", "Agent info Corinne"))
fn = Dir(Chemin & "*.xlsm")
Application.ScreenUpdating = False
Do While fn <> ""
With Workbooks.Open(Chemin & fn)
For Each el In tablo
Sheets(1).Cells.Replace el(0), el(1), xlPart, , True
Next
.Close True
End With
fn = Dir
Loop
End Sub
Bonjour,Bonsoir @dysorthographie
Y a de l'echo...
Et dans le message#7
J'ai encore du tombé dans la Twilight Zone
F = Dir(RépertoireAtraiter & "\*.Xlsm")
Sub DavidMM()
Dim F As String, Cn As Object
F = Dir(ThisWorkbook.Path & "\*.Xlsm")
Set Cn = CreateObject("AdoDb.connection")
With Cn
.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
While F <> ""
If F <> ThisWorkbook.Name Then
Maj ThisWorkbook.Path & "\" & F
End If
F = Dir
DoEvents
Wend
.Close
End With
End Sub
Sub Maj(Fichier As String)
Dim Cn As Object
Dim Sql As String
Set Cn = CreateObject("AdoDb.connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
With Sheets("Remplace").Range("A1").CurrentRegion
For i = 2 To .Rows.Count
Sql = "UPDATE [Feuil1$] " & _
" SET [NOM] = '" & Replace(.Cells(i, "B"), "'", "''") & "'" & _
" Where [NOM]= '" & Replace(.Cells(i, "A"), "'", "''") & "'"
Cn.Execute Sql
Next
End With
Cn.Close
End Sub
Re,Staple1600, il ne manque pas quelque chose à ce mode operatoire ?
Pour insérer la macro
Dans un classeur vierge, faire ALT+F11
puis Insertion/Module
Coller dans ce module la macro
Puis retourner dans Excel en faisant de nouveau ALT+F11
Enfin faire Affichage/Macro/Afficher les macros
Et exécuter la macro test_replace_II