Sur une synthèse de différents onglets, comment ajouter le nom des onglets?

Question

Bonjour,
Sur un fichier comportant différents onglets, je réalise une synthèse en copiant collant une plage de données de chaque onglet sur une feuille pour en dresser une liste. Voici le code qui est fonctionnel :

Public Sub liste()

    Dim oSh As Worksheet
    Dim oShR As Worksheet
    Const S_RECAP As String = "Liste "
    Dim iLigCible As Integer

    Set oShR = Worksheets(S_RECAP)

    For Each oSh In Worksheets
        If oSh.Name <> S_RECAP Then
            oSh.Range("$B$41:$E$44").Copy
            iLigCible = oShR.Range("B" & Rows.Count).End(xlUp).Row + 1
            oShR.Range("B" & iLigCible).PasteSpecial xlPasteAll
            Application.CutCopyMode = False
        End If
    Next oSh

    Set oShR = Nothing

End Sub

Je souhaite ajouter, devant chaque ligne copiée le nom de l'onglet où elle a été prélevée. Excemple : [nom_de_longlet] puis cellules B41 à E41 et ainsi de suite.

Je sèche. Sauriez vous m'aider ?

pijaku · Answer

Essayez : Public Sub liste() Dim oSh As Worksheet Dim oShR As Worksheet Const S_RECAP As String = "Liste " Dim iLigCible As Integer Set oShR = Worksheets(S_RECAP) For Each oSh In Worksheets If oSh.Name &lt;&gt; S_RECAP Then oSh.Range("$B$41:$E$44").Copy iLigCible = oShR.Range("B" & Rows.Count).End(xlUp).Row + 1 oShR.Range("B" & iLigCible).Value = oSh.Name 'insère le nom de l'onglet oShR.Range("B" & iLigCible + 1).PasteSpecial xlPasteAll 'colle en dessous du nom de l'onglet Application.CutCopyMode = False End If Next oSh Set oShR = Nothing End Sub...