Consolider classeur avec actualisation possible

Mathieu34 · 22 Février 2017

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 !!

Patrice33740 · 23 Février 2017

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

Mathieu34 · 23 Février 2017

Bonjour,

Super cela fonctionne! Je te remercie infiniment!

Consolider classeur avec actualisation possible

Mathieu34

XLDnaute Nouveau

Pièces jointes

Patrice33740

XLDnaute Impliqué

Mathieu34

XLDnaute Nouveau

Discussions similaires