Erreur n°1004 - Fichier introuvable

Bonjour,

le but de cette macro est de récupérer chaque fichier *.xlxm dans le répertoire MAR, d'effectuer quelques modifications dessus et de l'enregistrer dans un autre répertoire FAB en *.xlsx.

Cela marche de temps en temps et parfois j'ai ce message :

Erreur n°1004 - Fichier introuvable. Vérifiez l'orthographe du nom du classeur et la validité de l'emplacement.

Or mes fichiers se trouvent bien à l'emplacement indiqué. et le débogage m'envoie sur la ligne suivante :

Workbooks.Open Filename:=CheminMAR & Fichier

Sub Pour_FAB()
Dim CheminMAR As String
Dim CheminFAB As String
Dim Fichier As String
Dim i As Long
Dim S As Integer

Application.DisplayAlerts = False
CheminMAR = ThisWorkbook.Path & "\MAR\"
CheminFAB = ThisWorkbook.Path & "\FAB\"
If Dir(CheminFAB, 16) = "" Then MkDir CheminFAB
Fichier = Dir(CheminMAR & "*.xlsm")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Fichier <> ""
For i = 1 To Sheets.Count
Workbooks.Open Filename:=CheminMAR & Fichier
'Suppression des lignes en trop
For S = 4 To Sheets.Count 'à partir de la 4e feuille
ActiveWorkbook.Sheets(S).Select 'Sélectionner toutes les feuilles
Rows(1).EntireRow.Delete Shift:=xlUp
Rows(2).EntireRow.Delete Shift:=xlUp
Next S

Sheets(Array("Index", "GAB_1", "GAB_2")).Select
Sheets("GAB_2").Activate
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Import_DATA")
newname = Replace(ActiveWorkbook.Name, ".xlsm", "")
ActiveWorkbook.SaveAs Filename:=CheminFAB & newname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False  'renommer
ActiveWorkbook.Close
Fichier = Dir
Next i
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Quit
End Sub

En fait cela plante au dernier classeur.

Quelqu'un aurait il une idée ?

Bonne journée à tous

Il semblerait que ce soit au niveau de la chaîne de caractères que le problème se situe.

Comment faire pour ne pas prendre en compte les espaces dans les noms de fichiers.

Bonjour

A vérifier le nom du fichier lorsque il y a plantage

Passes ton curseur sur le mot "Fichier" tu devrais voir le nom du fichier en ControlTipText

Sinon dans la fenêtre exécution tapes

? fichier ---> entrée

Tu auras son nom et compares le avec les noms des fichiers dans ton répertoire

En fait, j'ai l'impression que cela cherche un fichier vide

Bonjour

Je trouve ton code un peu bizarre : Le fait que dans une boucle For i = 1 To Sheets.Count tu ouvres un fichier

Mais comme je n'ai pas ton/tes fichier(s), c'est peut-être normal

Je rajouterai la ligne surlignée

Sub Pour_FAB()
Dim CheminMAR As String
Dim CheminFAB As String
Dim Fichier As String
Dim i As Long
Dim S As Integer

  Application.DisplayAlerts = False
  CheminMAR = ThisWorkbook.Path & "\MAR\"
  CheminFAB = ThisWorkbook.Path & "\FAB\"
  If Dir(CheminFAB, 16) = "" Then MkDir CheminFAB
  Fichier = Dir(CheminMAR & "*.xlsm")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Do While Fichier <> ""
    For i = 1 To Sheets.Count
      Workbooks.Open Filename:=CheminMAR & Fichier
      'Suppression des lignes en trop
      For S = 4 To Sheets.Count 'à partir de la 4e feuille
        ActiveWorkbook.Sheets(S).Select 'Sélectionner toutes les feuilles
        Rows(1).EntireRow.Delete Shift:=xlUp
        Rows(2).EntireRow.Delete Shift:=xlUp
      Next S

      Sheets(Array("Index", "GAB_1", "GAB_2")).Select
      Sheets("GAB_2").Activate
      ActiveWindow.SelectedSheets.Delete
      ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Import_DATA")
      newname = Replace(ActiveWorkbook.Name, ".xlsm", "")
      ActiveWorkbook.SaveAs Filename:=CheminFAB & newname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False  'renommer
      ActiveWorkbook.Close
      Fichier = Dir
     If Dir = "" Then Exit Do
    Next i
  Loop
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  Application.Quit
End Sub

Merci encore,

En fait tu m'as mis sur la voie.

Le For I et Next i ne servent à rien.

Sub Pour_FAB()
Dim CheminMAR As String
Dim CheminFAB As String
Dim Fichier As String
Dim i As Long
Dim S As Integer

  Application.DisplayAlerts = False
  CheminMAR = ThisWorkbook.Path & "\MAR\"
  CheminFAB = ThisWorkbook.Path & "\FAB\"
  If Dir(CheminFAB, 16) = "" Then MkDir CheminFAB
  Fichier = Dir(CheminMAR & "*.xlsm")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Do While Fichier <> ""
    'For i = 1 To Sheets.Count
      Workbooks.Open Filename:=CheminMAR & Fichier
      'Suppression des lignes en trop
     For S = 4 To Sheets.Count 'à partir de la 4e feuille
       ActiveWorkbook.Sheets(S).Select 'Sélectionner toutes les feuilles
       Rows(1).EntireRow.Delete Shift:=xlUp
        Rows(2).EntireRow.Delete Shift:=xlUp
      Next S

      Sheets(Array("Index", "GAB_1", "GAB_2")).Select
      Sheets("GAB_2").Activate
      ActiveWindow.SelectedSheets.Delete
      ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Import_DATA")
      newname = Replace(ActiveWorkbook.Name, ".xlsm", "")
      ActiveWorkbook.SaveAs Filename:=CheminFAB & newname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False  'renommer
     ActiveWorkbook.Close
      Fichier = Dir
    'Next i
  Loop
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  Application.Quit
End Sub