Microsoft 365 Copier les mêmes lignes venant de différentes feuilles dans une feuille "Summary"

[liod21]

Bonjour à tous,

Je voudrais une macro qui me permet de copier les lignes allant de J à R (qui se trouvent sur la ligne Total) de chaque feuille et me les mets dans une feuille sumamry.

Peut-être trouvé une méthode qui dit " Dans chaque feuille, sur la ligne où il y a écrit Total, tu me copies les résultats allant de la colonne J à la colonne R et tu les mets dans la feuille summary dans la colonne B à J" ou dire " Sur la dernière ligne de donnée de chaque feuille (ça sera celle de Total), tu me copies les résultats allant de la colonne J à la colonne R et tu les mets dans la feuille summary dans la colonne B à J". Dans les 4 images que j'ai mis, mon fichier de base se compose des 3 premières images qui comprend les feuilles : Summary;Sheet2 et Sheet3; et ce que je voudrais se trouve sur la dernière photo "What I want".

Merci à vous,

 

[Robert]

Bonjour Liod, bonjour le forum,

Ou... Joindre le fichier qui va bien pour nous permettre de tester une éventuelle solution.

 

[job75]

Bonjour liod21, Robert,

Le problème a été posé sur l'autre fil et j'y ai répondu :

https://excel-downloads.com/threads...ur-mes-feuilles-excel.20069582/#post-20526502

Sub Summary()
Dim F As Worksheet, lig&, w As Worksheet, total As Range
Set F = Sheets("Summary") 'feuille de destination, à adapter
lig = 1
Application.ScreenUpdating = False
F.Cells(lig + 1, 2).Resize(F.Rows.Count - lig, 9).ClearContents 'RAZ
For Each w In Worksheets
    Set total = w.Columns("I").Find("Total", , xlValues, xlWhole)
    If Not total Is Nothing Then
        lig = lig + 1
        F.Cells(lig, 2).Resize(, 9) = total(1, 2).Resize(, 9).Value
    End If
Next
With F.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

A+

 

[liod21]

Bonjour liod21, Robert,

Le problème a été posé sur l'autre fil et j'y ai répondu :

https://excel-downloads.com/threads...ur-mes-feuilles-excel.20069582/#post-20526502

Sub Summary()
Dim F As Worksheet, lig&, w As Worksheet, total As Range
Set F = Sheets("Summary") 'feuille de destination, à adapter
lig = 1
Application.ScreenUpdating = False
F.Cells(lig + 1, 2).Resize(F.Rows.Count - lig, 9).ClearContents 'RAZ
For Each w In Worksheets
    Set total = w.Columns("I").Find("Total", , xlValues, xlWhole)
    If Not total Is Nothing Then
        lig = lig + 1
        F.Cells(lig, 2).Resize(, 9) = total(1, 2).Resize(, 9).Value
    End If
Next
With F.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

A+

Top, merci beaucoup !