Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Consolider classeur avec actualisation possible

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

  • ConsolideClasseursRepertoirex.xls
    40.5 KB · Affichages: 35

Patrice33740

XLDnaute Impliqué
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…