fonction Dir

[nonoTT]

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 ?

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

 

[Yaloo]

Re : fonction Dir

Bonsoir nonoTT,

Avec ceci

If Dir(chemin, vbDirectory) = "" Then MkDir chemin

A te relire

Martial

 

[Dranreb]

Re : fonction Dir

Bonsoir.

Je suppose alors que le nom de votre sous répertoire à ne pas inclure au Dir finit par ".xls" ???
Dans ce cas essayez comme ça :

ChDrive "C"
ChDir Repertoire & "\" & SousRépertoire
NF = Dir("*.xls") ' premier fichier
Do While NF <> ""
   If (GetAttr(NF) And vbDirectory) = 0 Then
      Workbooks.Open Filename:=NF
      n = [A1].CurrentRegion.Rows.Count - 1
      [A1].CurrentRegion.Offset(1, 0).Copy _
      ThisWorkbook.Worksheets("synthese").[A65000].End(xlUp).Offset(1, 0)
      ActiveWorkbook.Close False
      End If
   NF = Dir ' fichier suivant
   Loop

Remarque: vous auriez intérêt à remplacer ThisWorkbook.Worksheets("synthese") par le nom VBA de l'objet Worksheet correspondant, indiqué dans la rubrique "Microsoft Excel Objets" à gauche de "(synthese)"

Cordialement.