Remplacement auto

Comme ceci :

'---------------------------------------------------------------------
Sub SaveAsTextFile()

Dim Répertoire As String, Chemin As String
Dim fFileName As Variant, C As Variant
Dim A As Integer, B As Integer, X As Variant
Dim Tmp As String, Sep As String
Dim Rg As Range, Are As Range, Nnom As String
Dim NomFeuille As String

'************Variable à définir************
'Nom de la feuille où sont les données
NomFeuille = "Feuil1"
'Le séparateur des éléments du fichier texte
Sep = ";"
'*******************************************

Do
Do
'Nom du fichier
If Répertoire <> "" Then
fFileName = Application.InputBox(Prompt:="Ce nom de" & _
" fichier existe déjà." & vbCrLf & _
"Choisissez un autre nom que """ & fFileName & """.", _
Title:="Nom du fichier texte à définir", Type:=3)
Else
fFileName = Application.InputBox(Prompt:="Saisir le " & _
"nom du fichier texte à créer." _
, Title:="Nom du fichier texte à définir", Type:=3)
End If

'S'assurer que le nom du fichier ne contient pas un des symboles
'interdits par Microsoft / : * ? > < |
X = CheckName(fFileName)
If X = False Then
MsgBox "Le nom du fichier ne peut pas contenir " & vbCrLf & _
"l'un ces symboles suivants : / : * ? > < | " & _
vbCrLf & vbCrLf & "Corriger.", vbCritical, "Attention"

End If
Loop Until X = True

If TypeName(fFileName) <> "Boolean" Then
'S'assurer de la présence de l'extension du fichier
If LCase(Right(fFileName, 4)) <> ".txt" Then
fFileName = fFileName & ".txt"
End If

'Si l'usager clique sur le bouton annuler de la fenêtre
Else
MsgBox "Opération annulée. Nom de fichier non défini.", _
vbOKOnly + vbInformation, "Opération annulée"
Exit Sub
End If

If Répertoire = "" Then
Do
'Choix du répertoire où le fichier sera créé
Répertoire = BrowseFile(Chemin)
Loop Until Dir(Répertoire, vbDirectory) <> ""
End If

'Teste pour déterminer si un tel fichier existe déjà
'dans le répertoire retenu...
X = Dir(Répertoire & "" & fFileName)
DoEvents
Loop Until X = ""

'/////// Cette section détermine la plage de cellules
'/////// Suppose que la feuille contient seulement les données
With ThisWorkbook.Worksheets(NomFeuille) ' à déterminer
R = .Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
C = .Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
Set Rg = .Range(.Range("A2"), .Cells(R, C))
End With

'//////Si tu préfères ta méthode, supprime ce qui précède et
'//////enlève les apostrophes devant les lignes de code
'With Worksheets(NomFeuille) 'nom de la feuille à enregistrer
' C = .Range(.Range("A2"), .Range(AdrFin)) 'plage de cellules.
'End With

Open Répertoire & "" & fFileName For Output As #1
For Each Are In Rg.Areas
C = Are.Value
For A = 1 To UBound(C, 1)
Tmp = ""
For B = 1 To UBound(C, 2)
If Tmp > "" Then
Tmp = Tmp & Sep & C(A, B)
Else
Tmp = C(A, B)
End If
Next
Print #1, Tmp
Next
Erase C
Next
Close #1

End Sub
'---------------------------------------------------------------------
Function CheckName(fFileName As Variant) As Boolean
'Vérification des caractères du nom de fichier
Dim X(), Elt As Variant
X = Array("", "/", ":", "*", "?", ">", "<", "|")
For Each Elt In X
If InStr(1, fFileName, Elt, vbTextCompare) > 0 Then
CheckName = False
Exit Function
End If
Next
CheckName = True
End Function
'---------------------------------------------------------------------
Function BrowseFile(Optional Chemin As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
'Définit un titre pour la boîte de dialogue
.Title = "Choisissez le répertoire de destination du fichier..."
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = Chemin
'Affiche la boîte de dialogue
.Show
'Si un répertoire a été sélectionné
'par défaut le répertoire en cours à l'ouverture de la fenêtre
If .SelectedItems.Count = 1 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'---------------------------------------------------------------------

MichD

Merci MichD,
Grâce à vous mon projet c'est très nettement améliorà © et embellit,
Merci aussi à tous les membres de ce forum qui partage leurs connaissa nces si gentiment.

Cordialement.
Régis