Option Explicit
Sub Macro1()
Dim I As Integer, NbFichiers As Integer
Dim Dossier As String, TypeFichier As String
Dim Origine() As String, Destination() As String
Dim NomFichier As String, Ligne1 As String
Dim NbErreurs As Integer
Dim AppPath As String
On Error GoTo GestErreur
NbFichiers = 0
Dossier = "C:\origine\"
TypeFichier = "*.txt"
AppPath = ThisWorkbook.Path & "\"
NomFichier = Dir(Dossier & TypeFichier)
Do While Len(NomFichier) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Origine(NbFichiers)
Origine(NbFichiers) = Dossier & NomFichier
NomFichier = Dir()
Loop
ReDim Destination(NbFichiers)
If NbFichiers > 0 Then
For I = 1 To UBound(Origine)
Open Origine(I) For Input As #1
Do
Input #1, Ligne1
Loop Until Trim(Ligne1) <> ""
Close #1
Destination(I) = AppPath & Ligne1 & ".txt"
Next
End If
For I = 1 To UBound(Origine)
FileCopy Origine(I), Destination(I)
Next I
If NbErreurs > 0 Then MsgBox "Le programme a rencontré " & NbErreurs & " erreurs correspondant à des fichiers corrompus ou à des caractères interdits dans les noms de fichiers.", vbCritical + vbOKOnly, "Erreurs"
Exit Sub
GestErreur:
NbErreurs = NbErreurs + 1
'MsgBox Err.Number & vbLf & Err.Description
Resume Next
End Sub