Consolider classeur avec actualisation possible

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Mathieu34

XLDnaute Nouveau
Bonjour 🙂,

Je viens de parcourir les différents sujets du forum à propos de ma recherche mais je ne trouve pas de réponse... J'ai utilisé le code suivant (Merci à BOISGONTIER😉) pour consolider mes classeurs en 1 seul classeur avec plusieurs onglets, jusque ici tout est ok.

Code:
Sub consolide()
  ChDir ActiveWorkbook.Path
  Set classeurMaitre = ActiveWorkbook
  sup
  compteur = 1
  nf = Dir("*.xls")
  Do While nf <> ""
    If nf <> classeurMaitre.Name Then
      Workbooks.Open Filename:=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
      Workbooks(nf).Close False
    End If
    nf = Dir
  Loop
End Sub

Sub sup()
  Application.DisplayAlerts = False
  If Sheets.Count > 1 Then
    Sheets("Accueil").Move before:=Sheets(1)
    Sheets(2).Select
    For i = 2 To Sheets.Count
      ActiveSheet.Delete
    Next i
  End If
End Sub

Mon problème est que la consolidation n'est pas évolutive. Je m'explique. Une fois que j'ai consolidé les fichiers je ne peux pas en rajouter d'autres plus tard. Si je veux rajouter d'autres fichiers des que je vais consolider cela va écraser les fichiers que j'avais déjà fusionné et donc me laisser que les nouveaux.

J'aimerai savoir si il est possible de rajouter des fichiers après une première consolidation sur le même fichier sans que les autres soient effacés ?

Quelqu'un peut-il m'aider? 🙂

Merci d'avance !!
 

Pièces jointes

Bonjour,

Essaies :
VB:
Sub consolide()
  ChDir ActiveWorkbook.Path
  Set classeurMaitre = ActiveWorkbook
  With classeurMaitre
    If .Sheets.Count > 1 Then .Sheets("Accueil").Move before:=.Sheets(1)
    compteur = .Sheets.Count
  End With
  nf = Dir("*.xls")
  Do While nf <> ""
    If nf <> classeurMaitre.Name Then
      Workbooks.Open Filename:=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
      Workbooks(nf).Close False
    End If
    nf = Dir
  Loop
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour