Bonjour dans la macro suivante je cherche à consolider le contenu de plusieurs fichiers contenus dans le même répertoire.
La macro créée aussi un fichier récapîtulatif dans un sous répertoire où les fichiers sont à consolider.
Du coup la fonction dir de ma macro veut récupérer le fichier récapitulatif et me fait une erreur.
Comment palier à ceci ? est il possible d'enlever le sous répertoire de la recherche par Dir ?
La macro créée aussi un fichier récapîtulatif dans un sous répertoire où les fichiers sont à consolider.
Du coup la fonction dir de ma macro veut récupérer le fichier récapitulatif et me fait une erreur.
Comment palier à ceci ? est il possible d'enlever le sous répertoire de la recherche par Dir ?
Code:
Sub syntèseClasseur()
Dim nvfichier, chemin, nomois, Repertoire, sousRépertoire, Fichier As String
nommois = InputBox("Entrer le nom du mois (entier, sans majuscule et sans accents )", "question")
If nommois = "janvier" Then
nomois = "01"
ElseIf nommois = "fevrier" Then
nomois = "02"
ElseIf nommois = "mars" Then
nomois = "03"
ElseIf nommois = "avril" Then
nomois = "04"
ElseIf nommois = "mai" Then
nomois = "05"
ElseIf nommois = "juin" Then
nomois = "06"
ElseIf nommois = "juillet" Then
nomois = "07"
ElseIf nommois = "aout" Then
nomois = "08"
ElseIf nommois = "septembre" Then
nomois = "09"
ElseIf nommois = "octobre" Then
nomois = "10"
ElseIf nommois = "novembre" Then
nomois = "11"
ElseIf nommois = "decembre" Then
nomois = "12"
End If
Repertoire = "C:\monrepertoire"
sousRépertoire = nomois & ".2013 Récap CQI " & nommois & " 2013"
Fichier = "Recap TK CIQ-" & nommois & " 2013.xlsx"
chemin = Repertoire & "\" & sousRépertoire & "\synthese"
'vérifier si le répertoire existe
On Error Resume Next
ChDir chemin
If Err Then MkDir chemin 'pour le créer
On Error GoTo 0
Set nvfichier = Workbooks.Add
With nvfichier
.Title = Fichier
.SaveAs Filename:=chemin & "\" & Fichier
End With
Sheets(1).Name = "synthese"
nvfichier = chemin & "\" & Fichier
[A2].CurrentRegion.Offset(1, 0).Clear
Set maitre = ThisWorkbook
nf = Dir(Repertoire & "\" & sousRépertoire & "\*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=Repertoire & "\" & sousRépertoire & "\" & nf
n = [A1].CurrentRegion.Rows.Count - 1
[A1].CurrentRegion.Offset(1, 0).Copy _
maitre.Sheets("synthese").[A65000].End(xlUp).Offset(1, 0)
ActiveWorkbook.Close False
'-- nom onglet
'[A1].End(xlDown).End(xlToRight).Offset(-n + 1, 1).Resize(n, 1) = Left(nf, Len(nf) - 4)
nf = Dir ' fichier suivant
Loop
End sub