Transfert de plusieurs feuils en 1 feui avec nom d'onglet

Bonjour à tous,

Petit tracas! J'ai créer un macro me permettant de transférer le contenu de chaque feuille (9 feuilles total) de $A$2 à $K$1. Dans la feuille de destination que j'ai appeler "Source", le tableau est le même sauf que j'y ai ajouter une colonne en A - je souhaite que lors du transfert automatique le nom de l'onglet s'ajoute automatiquement dans cette colonnem mais je n'y arrive pas.

Et voilà! J'espère que vous pourrez m'aider.

Voici ma macro:

' Procédure permttant la consoliation des feuilles du classeur

Sub Consolider()

Application.ScreenUpdating = False

effacedonnee

'Boucle permettant de lire toute les feuilles à consolider

For j = 1 To 9 ' Parcourir les feuilles des noms d'expert

Sheets(j).Select

DerniereLigne = Range("B100000").End(xlUp).Row

For i = 2 To DerniereLigne 'parcours des lignes de chaque table

Sheets(j).Select

Rows(i).Select

Selection.Copy

Sheets("Source").Select

LastRowSource1 = Range("a1000000").End(xlUp).Row + 1

Cells(LastRowSource1, 1).Select

ActiveSheet.Paste

Application.CutCopyMode = False

Next i

Next j

Application.ScreenUpdating = False

MsgBox "La mise à jour est terminée ", vbOKOnly + vbInformation, "Information"

End Sub

Merci à l'avance

Bonsoir Chouinards, bonsoir le forum,

Si dans tes plages il n'y a pas de ligne vide entre les données ou de colonne vide entre les données, le code ci-dessous devrait convenir :

Sub Consolider()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim S As Worksheet 'déclare la variable S (onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)

Set S = Worksheets("Source") 'définit l'onglet S
For Each O In Sheets 'boucle sur tous les onglets du classeur
    If Not O.Name = "Source" Then 'condition : si l'onglet ne se nomme pas "Source"
        'définit la cellule de destination DEST (A1 de l'onglet S, si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet S)
        Set DEST = IIf(S.Range("A1").Value = "", S.Range("A1"), S.Range("A" & Application.Rows.Count).End(xlUp).Offset(1, 0))
        With O.Range("B1").CurrentRegion.EntireRow 'prend en compte les lignes entières de la plage des cellules adjacentes à B1
            NL = .Rows.Count 'définit le nombre de ligne NL
            .Copy DEST 'copie la plage dans DEST
        End With 'fin de la prise en compte de ...
        DEST.Resize(NL, 1).Value = O.Name 'renvoie de nom de l'onglet dans la colonne A de toutes les cellules de la plage
    End If 'fin de la condition
Next O 'prochain onglet de la boucle
MsgBox "La mise à jour est terminée ", vbOKOnly + vbInformation, "Information" 'message
End Sub

Bonsoir ThauThème, Bonsoir Chouinards,

une réponse un peu moins "pro" dans la syntaxe du code :

https://forum.excel-pratique.com/post481779.html#p481779

@ bientôt

LouReeD

Salut

Ceci est un exemple