Consolidation de plusieurs feuilles dans une seule feuille

Bonsoir à toutes à tous,

Depuis un moment j'utilise le code suivant qui fonctionne bien

Sub Consolidation_2()
Dim w1 As Workbook, w2 As Workbook
Dim f1 As Worksheet, f2 As Worksheet
Dim l&, i&, k&, t(), temp(), Liste(), nw2

Set w1 = ThisWorkbook: Set f1 = w1.Sheets("Recap Conso")
Liste = Array("SOURCE 1", "SOURCE 2", "SOURCE 3", "SOURCE 4", "SOURCE 5")

'On choisit le fichier à ouvrir
nw2 = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
    If nw2 <> False Then
        Set w2 = Workbooks.Open(nw2)
        Else: MsgBox "Vous n'avez pas sélectionné de fichier": Exit Sub
    End If

'On débute le compteur à 0, afin de savoir s'il s'agit du premier tableau.
k = 0

'On boucle les différentes feuilles.
With w2
    For i = LBound(Liste) To UBound(Liste)
        With .Sheets(Liste(i))
            l = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            temp = .Range(.Cells(2, 1), .Cells(l, 20)).Value
            If k = 0 Then
            .Rows(1).Copy f1.[a1]
                t = temp
                Else: t = MergeArray2DVert(t, temp)
            End If
        End With
    k = k + 1
    Next i
End With

'On ferme le classeur à consolider.
w2.Close False

'On note les valeurs dans le classeur d'origine.
With f1.[a2].Resize(UBound(t), UBound(t, 2))
    .NumberFormat = "@"
    .Value = t
End With
End Sub

Function MergeArray2DVert(a, b)
  maxtab1 = UBound(a)
  Dim Tbl(): ReDim Tbl(1 To UBound(a) + UBound(b), 1 To UBound(a, 2))
  For i = LBound(a) To UBound(a)
    For c = 1 To UBound(a, 2): Tbl(i, c) = a(i, c): Next
  Next i
  For i = 1 To UBound(b)
    For c = 1 To UBound(b, 2): Tbl(maxtab1 + i, c) = b(i, c): Next
  Next i
  MergeArray2DVert = Tbl
End Function

Mais je voudrai ajouter le nom de la feuille source dans le fichier consolidé (colonne 21 : à la fin)

pouvez vous m'aider à ajouter cette évolution qui va me faire gagner beaucoup de temps ?

D'avance, merci pour vos propositions

A+

Bonjour.

Déclare la variable source en String.

Dim source$

Enregistre la variable :

'On boucle les différentes feuilles.
With w2
    source = .Name
    For i = LBound(Liste) To UBound(Liste)

Et inscrit la variable dans ton fichier consolidé.

With f1.[a2].Resize(UBound(t), UBound(t, 2))
    .NumberFormat = "@"
    .Value = t
    f1.Cells(UBound(t) + 1, 21).Value = source
End With

Bonjour et merci pour votre proposition,

je viens de modifier le code comme suit :

Sub Consolidation_2()
Dim w1 As Workbook, w2 As Workbook
Dim f1 As Worksheet, f2 As Worksheet
Dim l&, i&, k&, t(), temp(), Liste(), nw2
Dim source$

Set w1 = ThisWorkbook: Set f1 = w1.Sheets("Recap Conso")
Liste = Array("SOURCE 1", "SOURCE 2", "SOURCE 3", "SOURCE 4", "SOURCE 5")

'On choisit le fichier à ouvrir
nw2 = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
    If nw2 <> False Then
        Set w2 = Workbooks.Open(nw2)
        Else: MsgBox "Vous n'avez pas sélectionné de fichier": Exit Sub
    End If

'On débute le compteur à 0, afin de savoir s'il s'agit du premier tableau.
k = 0

'On boucle les différentes feuilles.
With w2
    source = .Name
    For i = LBound(Liste) To UBound(Liste)
        With .Sheets(Liste(i))
            l = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            temp = .Range(.Cells(2, 1), .Cells(l, 20)).Value
            If k = 0 Then
            .Rows(1).Copy f1.[a1]
                t = temp
                Else: t = MergeArray2DVert(t, temp)
            End If
        End With
    k = k + 1
    Next i
End With

'On ferme le classeur à consolider.
w2.Close False

'On note les valeurs dans le classeur d'origine.
With f1.[a2].Resize(UBound(t), UBound(t, 2))
    .NumberFormat = "@"
    .Value = t
    f1.Cells(UBound(t) + 1, 21).Value = source
End With

End Sub

Function MergeArray2DVert(a, b)
  maxtab1 = UBound(a)
  Dim Tbl(): ReDim Tbl(1 To UBound(a) + UBound(b), 1 To UBound(a, 2))
  For i = LBound(a) To UBound(a)
    For c = 1 To UBound(a, 2): Tbl(i, c) = a(i, c): Next
  Next i
  For i = 1 To UBound(b)
    For c = 1 To UBound(b, 2): Tbl(maxtab1 + i, c) = b(i, c): Next
  Next i
  MergeArray2DVert = Tbl
End Function

Mais malheureusement le résultat ne répond pas à mes besoins :

Au niveau de la dernière ligne de la colonne 21, il est inscrit le libellé du classeur source ! or que je voudrai avoir le libellé de la feuille source (source 1, source 2...) pour toutes les lignes de cette colonne

Pour plus de détails, je vous joints les 2 fichiers en question avec le dernier code

est-il possible de revoir ce qui ne fonctionne pas !

merci

Pour complément d'informations, en modifiant la source, j'ai eu le libellé de la feuille mais toujours uniquement au niveau de la dernière ligne de la colonne 21

source = Sheets(Liste(i)).Name

Si j'ai bien compris la demande cette fois ci :

'On boucle les différentes feuilles.
With w2
    For i = LBound(Liste) To UBound(Liste)
        With .Sheets(Liste(i))
            l = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            temp = .Range(.Cells(2, 1), .Cells(l, 21)).Value
            For m = LBound(temp) To UBound(temp)
                temp(m, 21) = Liste(i)
            Next m
            If k = 0 Then
            .Rows(1).Copy f1.[a1]
                t = temp
                Else: t = MergeArray2DVert(t, temp)
            End If
        End With
    k = k + 1
    Next i
End With

Bonjour thebenoit59 et merci beaucoup pour votre proposition

je viens de tester le nouveau code et ça marche très bien mais juste il y a un petit problème : au niveau de la dernière ligne de la colonne 21, il n'y a pas le nom de la feuille source (à l'inverse des les autres lignes ou j'ai bien le nom des feuilles sources)

Est-il possible de corriger ce petit point ?

Merci d'avance

Chez moi aucun soucis.

Peut-être que cette ligne est une ancienne. Essaye en nettoyant ta feuille et en lançant le code ensuite.

J'ai refait l'exécution du code plusieurs fois, mais j'ai toujours le même problème

Ci-joint le fichier ou vous pouvez voir que la cellule U77 (dernière ligne de la colonne 21) est vide malgré qu'elle provient de la feuille 'source 5'

parait, j'ai modifié la traille des feuilles et à chaque la dernier ligne colonne 21 est vide !!

Il faut supprimer la première réponse avec le source (déclaration, source = et inscription dans le classeur de consolidation).

Excusez moi je n'ai pas bien compris votre réponse :qu'est ce qu'il faire exactement :

 f1.Cells(UBound(t) + 1, 21).Value= source

est ce je dois modifier la ligne ci-dessus ?

Merci

Ne pas tenir compte de la première solution c'est tout

Ah d'accord, merci beaucoup