.txt : répertoire complet

[Trice]

'Jour à tous
Comment peut on modifier la macro ci joint de façon à ce qu'elle
s'applique à tous les fichiers .txt d'un meme répertoire (le chemin étant écrit dans la cellule 'D4'.)
Et ce, sans apparation des messages style : Voulez vous enregistrer..........

Merci bien à vous
Trice

Sub Macro1()
ChDir 'C:\\'
Workbooks.OpenText Filename:='C:\\Fables.txt', Origin:=xlMSDOS, StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns('A:F').Select
Selection.Replace What:=';', Replacement:='.', LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range('A1').Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[JPM]

Bonjour Trice, le forum,

Essayes ça :

  Dim wsr As FileSystemObject
  Dim rep As Folder
  Dim fic As File
  
  Set wsr = New FileSystemObject
  Set rep = wsr.GetFolder(Range('D4'))
  
  'descativer l'affichage
  Application.ScreenUpdating = False

  'ne pas afficher les messages Excel
  Application.DisplayAlerts = False

  For Each fic In rep.Files
    Workbooks.OpenText Filename:=fic.Name, Origin:=xlMSDOS, StartRow:=1, _
      DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
      :=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
      Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Columns('A:F').Select
    Selection.Replace What:=';', Replacement:='.', LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Range('A1').Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
  Next
  
  Application.DisplayAlerts = True

Bonne chance

Jean-Pierre