Erreur runtime N°5 avec la fonction DIR

[popov]

Bonjour à tous,

Je suis débutant en VBA, mais j'essaie de créer un fichier me permettant de copier dans un fichier synthèse tous les onglets nommés "Report" de chaque fichier d'un dossier. De plus à chaque fois que je copie l'onglet, je veux le renommer selon la case L4.

En parcourant plusieurs forums, je suis arrivé au code ci-dessous, mais j'ai une erreur "run time n°5" lors de l'execution du code à la ligne:

Fich = Dir

Voici le code que j'ai obtenu:

Option Explicit
Sub BoucleDeTraitement1() ' la boucle de traitement des fichiers
Dim Feuille As Worksheet
Dim Lenom As String
Dim Flag As Boolean
Dim ws As Worksheet
Dim wb As Workbook
Dim wb1 As Workbook
Dim Fich As String
Const Chemin = "C:\Users\Fiche collectées\"
Application.ScreenUpdating = False
Fich = Dir(Chemin & "*.*")
While Len(Fich) > 0
Set wb = Workbooks.Open(Chemin & Fich)
Set ws = wb.Worksheets("Report")
Lenom = "Test12345" & ".xls"
Flag = FileExists(Chemin & Lenom) 'Test si le fichier existe
If Flag Then
Set wb1 = Workbooks.Open(Chemin & Lenom)
Workbooks.Open Lenom
ws.Name = Range("L4").Text 'Nomme l'onglet selon la cellule L4
ws.Copy After:=wb1.Sheets(wb1.Sheets.Count)
ws.Name = "Report" 'Nomme l'onglet report
ActiveWorkbook.Close True
Else
ws.Name = Range("L4").Text
ws.Copy
ws.Name = "Report"
ActiveWorkbook.Close savechanges:=True, Filename:=Lenom
End If
ActiveWorkbook.Close True
Fich = Dir
Wend
Application.ScreenUpdating = True
End Sub

Function FileExists(S As String) As Boolean
FileExists = Dir(S) <> ""
End Function

Est ce que quelqu'un à une idée de mon problème?

Merci d'avance!

 

[kjin]

Re : Erreur runtime N°5 avec la fonction DIR

bonjour,
Il y a incohérence dans ton code, mais avec le peu d'explication fourni....
Je comprends qu'à partir de ta macro tu ouvres 2 autres classeurs et puis ...
A+
kjin

 

[popov]

Re : Erreur runtime N°5 avec la fonction DIR

Merci de ta réponse, je m'excuse de mon peu d'explication, et j'espère que celle-ci permettront de mieux comprendre ma routine


Option Explicit
Sub BoucleDeTraitement1() ' la boucle de traitement des fichiers
Dim Feuille As Worksheet
Dim Lenom As String
Dim Flag As Boolean
Dim ws As Worksheet
Dim wb As Workbook
Dim wb1 As Workbook
Dim Fich As String
Const Chemin = "C:\Users\Fiche collectées\" 'Dossier dans lequel les fichiers excel à traiter sont présent
Application.ScreenUpdating = False
Fich = Dir(Chemin & "*.*") ' prends le premier fichier du dossier à traiter
While Len(Fich) > 0
Set wb = Workbooks.Open(Chemin & Fich) 'ouvre le fichier à traiter
Set ws = wb.Worksheets("Report") 'ouvre l'onglet à copier
Lenom = "Test12345" & ".xls" 'Nom du fichier de synthèse où les onglets vont être collés
Flag = FileExists(Chemin & Lenom) 'Test si le fichier existe
If Flag Then
Set wb1 = Workbooks.Open(Chemin & Lenom) 'ouvre le fichier synthèse
ws.Name = Range("L4").Text 'Nomme l'onglet selon la cellule L4
ws.Copy After:=wb1.Sheets(wb1.Sheets.Count) 'copie l'onglet dans le fichier de synthèse
ws.Name = "Report" 'Nomme l'onglet report 'redonne le nom d'onglet
ActiveWorkbook.Close True
Else
ws.Name = Range("L4").Text ' renomme l'onglet selon la case L4
ws.Copy ' copie l'onglet
ws.Name = "Report" 'redonne son nom d'origine à l'onglet de départ
ActiveWorkbook.Close savechanges:=True, Filename:=Lenom
End If
ActiveWorkbook.Close True
Fich = Dir 'choisit le fichier suivant
Wend
Application.ScreenUpdating = True
End Sub

Function FileExists(S As String) As Boolean
FileExists = Dir(S) <> "" 'fonciton qui vérifie si le fihier existe déjà
End Function

 

[kjin]

Re : Erreur runtime N°5 avec la fonction DIR

Bonsoir,

Sub BoucleDeTraitement1() ' la boucle de traitement des fichiers
Dim ws As Worksheet, wbDest As Workbook, wbSource As Workbook
Dim Rep$, wbSynt$, fSource$, nFeuille$

Application.ScreenUpdating = False
Rep = "C:\Users\Fiche collectées\"                  'Dossier
wbSynt = "Test12345.xls"                            'fichier de synthèse

If Dir(Rep & wbSynt) <> "" Then                     'test si wbSynt existe
    Set wbDest = Workbooks.Open(Rep & wbSynt)       'l'ouvre si oui
Else
    Set wbDest = Workbooks.Add                      'sinon le crée
    wbDest.SaveAs Rep & wbSynt                      'et le sauve
End If
fSource = Dir(Rep & "*.xls")                        'test fichier "xls" du dossier
While Len(fSource) > 0 And fSource <> wbDest.Name   'test fSource
    Set wbSource = Workbooks.Open(Rep & fSource)    'ouvre le fichier à traiter
    Set ws = wbSource.Sheets("Report")              'ouvre l'onglet à copier
    nFeuille = ws.Range("L4").Text                  'récupère le nom de l'onglet en L4
    With wbDest
        ws.Copy After:=.Sheets(.Sheets.Count)       'copie l'onglet dans le fichier de synthèse
        ActiveSheet.Name = nFeuille                 'renome le nouvelle feuille
    End With
    wbSource.Close False                            'ferme wbSource
    fSource = Dir()                                 'choisit le fichier suivant
Wend
wbDest.Close True                                   'enregistre et ferme wbSynt

Application.ScreenUpdating = True
End Sub

A+
kjin

 

[popov]

Re : Erreur runtime N°5 avec la fonction DIR

Merci Beaucoup ! ça tourne rond !