XL 2013 Consolidation de plusieurs classeurs

sr94

XLDnaute Occasionnel
Bonjour,

J'ai essayé d'utiliser le code suivant mais en vain

Code:
Sub consolide()
  ChDir ActiveWorkbook.Path
  Set classeurMaitre = ActiveWorkbook

  compteur = 1
  nf = Dir("*.xls")
  Do While nf <> ""
    If nf <> classeurMaitre.Name Then
      Workbooks.Open Filename:=nf
      With Workbooks(nf)
      For k = 1 To .Sheets.Count
        .Sheets(k).Copy After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count)
        classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = "Mapage" & compteur
        compteur = compteur + 1
        
      Next k
      .Close False
      End With
    End If
    nf = Dir
  Loop
End Sub

Je souhaite consolider en un seul classeur tous les classeurs du répertoire où se trouve le fichier avec cette macro. Tous mes fichiers ont un seul onglet, et je souhaite avoir un onglet par classeur. (par exemple 10 classeurs= 10 onglets).

Le code ci-dessus me consolide un tas de classeurs qui ne sont pas dans le répertoire de la macro, que faut-il modifier ? par ailleurs je souhaiterai que chaque onglet prenne le nom du classeur.

Merci
Sandrine
 

sr94

XLDnaute Occasionnel
Re : Consolidation de plusieurs classeurs

si je mets le code suivant c'est ok

Code:
classeurMaitre.SaveAs ThisWorkbook.Path & "\" & "test.xlsx", FileFormat:=51

par contre avec le suivant j'ai une erreur, en fait le nom du fichier doit être le nom du répertoire où se trouve la macro et les fichiers à consolider :

Code:
classeurMaitre.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Path & ".xlsx", FileFormat:=51
 

sr94

XLDnaute Occasionnel
Re : Consolidation de plusieurs classeurs

j'ai trouvé un code sur internet qui a l'air de fonctionner et me permet de récupérer le nom du répertoire :

Code:
Sub consolide()
Dim tablo() As String
tablo() = Split(ActiveWorkbook.Path, "\")
Dossier = tablo(UBound(tablo))
ChDir ActiveWorkbook.Path
  Set classeurMaitre = ActiveWorkbook
  sup
  compteur = 1
  nf = Dir(ThisWorkbook.Path & "\*.xls")
  Do While nf <> ""
    If nf <> classeurMaitre.Name Then
    Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & nf
    For k = 1 To Sheets.Count
        Sheets(k).Copy After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count)
        classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = Mid(nf, 1, Len(nf) - 13)
        compteur = compteur + 1
      Next k
      Workbooks(nf).Close False
    End If
    nf = Dir
  Loop
  classeurMaitre.SaveAs ThisWorkbook.Path & "\" & Dossier]& ".xlsx", FileFormat:=51
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 231
Messages
2 086 450
Membres
103 214
dernier inscrit
MASSA1616