Nommer feuille suivant cellule et rassembler données

Question

J'ai trouvé un classeur qui permet de rassembler plusieurs fichiers excel sous plusieurs onglets. Jusque là tout va bien mais je souhaite que le 'nom" de ces feuilles soit nommés automatiquement suivant une cellule bien définie ce celles-ci Je vous joint le fichier pour explication. Les onglets pièce n°1, pièce n°2 et pièce n°3 doivent se nommer 60,61 et 62 suivant la cellule F8 de chaque onglet. Par la suite, je souhaite qu'un dernier onglet soit nommé "bilan" et centralise les valeurs de la colonne B à partir de B14 et jusqu'a la derniere valeur trouvée car je peux avoir + ou - de valeurs dans ma colonne B. Voici mon fichier tel que je voudrais qu'il soit en exécutant la macro. Je vous remercie de m'aider...

U. Milité · Answer

Pour ta demande concernant les noms des feuilles, tu peux (par exemple) remplacer les deux lignes suivantes dans ton code: classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = "Piece n°" &amp; compteur compteur = compteur + 1 Par celle-ci: classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = classeurMaitre.Sheets(classeurMaitre.Sheets.Count).&#91;F8&#93; Pour ta question relative à la "consolidation", il faudrait que tu précises si le contenu de la colonne A de chaque feuille reprend précisément les mêmes items et dans le même ordre...

U. Milité · Answer

... On va dire "à peu près", oui tu verras ce qu'il en est! Ajoute, entre le Loop et le End Sub, ces quelques lignes: Sheets("Bilan").&#91;A2&#93;.CurrentRegion.ClearContents For Each f In ThisWorkbook.Sheets If LCase(f.Name) &lt;&gt; "accueil" And LCase(f.Name) &lt;&gt; "bilan" Then derlig = f.Cells(Rows.Count, 1).End(xlUp).Row pos = 0 col = Sheets("bilan").Cells(1, Columns.Count).End(xlToLeft).Column + 1 Sheets("bilan").Cells(1, col) = f.Name For lig = 14 To derlig pos = Application.Match(f.Cells(lig, 1), Sheets("bilan").&#91;A:A&#93;, 0) If Not IsNumeric(pos) Then Sheets("bilan").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = f.Cells(lig, 1) Sheets("bilan").Cells(Rows.Count, 1).End(xlUp).Offset(0, col - 1) = f.Cells(lig, 2) Else Sheets("bilan").Cells(pos, col) = f.Cells(lig, 2) End If Next lig End If Next f ... il faudra, si elle n'existe pas, créer la feuille "Bilan". Si, en fin de compte, je n'ai rien compris, redépose un classeur avec des exemples de ce que tu aurais en réalité dans tes feuilles à consolider: le premier fichier ne semble pas correspondre à ce que tu expliques...

U. Milité · Answer

Attention au fait qu'il y a, au début du code, un appel à la procédure sup ... qui supprime toutes les feuilles sauf la feuille Accueil. Si tu avais créé la feuille Bilan, elle est supprimée au passage. Je te suggère de lancer la procédure sup seule (ou de supprimer à la main, les feuilles en dehors d'Accueil et Bilan).

Utilise ensuite ce code: (j'ai mis l'appel à sup en commentaire, ai précisé la référence au classeur ouvert et ajouté un petit ScreenUpdating=False pour le confort des yeux ). Ici, j'ai retesté deux fois, je n'ai pas de souci ... tu nous diras?

Sub consolide()
  ChDir ActiveWorkbook.Path
  Set classeurMaitre = ActiveWorkbook
  'sup
  Application.ScreenUpdating = False
  compteur = 1
  nf = Dir("*.xls")
  Do While nf <> ""
    If nf <> classeurMaitre.Name Then
      Set cl = Workbooks.Open(Filename:=nf)
      For k = 1 To cl.Sheets.Count
        cl.Sheets(k).Copy After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count)
        classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = classeurMaitre.Sheets(classeurMaitre.Sheets.Count).[F8]
      Next k
      Workbooks(nf).Close False
    End If
    nf = Dir
  Loop
Sheets("Bilan").[A2].CurrentRegion.ClearContents
For Each f In ThisWorkbook.Sheets
    If LCase(f.Name) <> "accueil" And LCase(f.Name) <> "bilan" Then
        derlig = f.Cells(Rows.Count, 1).End(xlUp).Row
        pos = 0
        col = Sheets("bilan").Cells(1, Columns.Count).End(xlToLeft).Column + 1
        Sheets("bilan").Cells(1, col) = f.Name
        For lig = 14 To derlig
            pos = Application.Match(f.Cells(lig, 1), Sheets("bilan").[A:A], 0)
            If Not IsNumeric(pos) Then
                Sheets("bilan").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = f.Cells(lig, 1)
                Sheets("bilan").Cells(Rows.Count, 1).End(xlUp).Offset(0, col - 1) = f.Cells(lig, 2)
            Else
                Sheets("bilan").Cells(pos, col) = f.Cells(lig, 2)
            End If
        Next lig
    End If
Next f
Application.ScreenUpdating = True
End Sub

U. Milité · Answer

Pour la procédure sup , il me semble que ceci devrait fonctionner: Sub sup() Application.DisplayAlerts = False If Sheets.Count &gt; 1 Then Sheets("Accueil").Move before:=Sheets(1) For i = Sheets.Count To 2 Step -1 If Sheets(i).Name &lt;&gt; "Bilan" Then Sheets(i).Delete Next i End If End Sub Le Application.ScreenUpdating=False permet de suspendre momentanément le rafraîchissement de l'écran ... tu ne vois donc pas les fichiers s'ouvrir et se refermer (c'est pour ça que je parlais de "confort"). Cette même instruction fait également gagner un peu de temps à l'exécution. Quant à ton message d'erreur, il ne semble pas être lié à la macro. Si tu le lis attentivement, tu constateras qu'Excel cherche (au démarrage) un fichier nommé ReportINI, qui figurerait dans le dossier XLSTART...