Excel, extraire des ligne sur autre onglet

Ca ne semble pas clair du tout donc voici un lien vers le document: https://www.cjoint.com/?AJkqIgvGjEo

Lorsque je clique sur le bouton à l'onglet 1, je souhaitera activer une macro qui vas chercher dans tous les onglets suivants (le nbr d'onglet peut évoluer) toutes les lignes Qui ont l'état "A faire" dans la colone E.

En gros, je souhaite rapatrier toutes les lignes "A faires" sur l'onglet 1 afin de pouvoir suivre toutes mes actions en attente.

A dispo si besoin de plus d'info.

EN EFFET, ce serait super si l'on pouvait ajouter pour chaque ligne extraite, le nom de l'onglet (qui de fait comporte la date de saisie).
C'est vrai qu'avec cette macro, les celules avec beaucoup de données ne sont pas adaptées en taille (toutes les infos ne sont pas visibles.

J'ai essayé et la macro de Michel_m fonctionne bien, ce serait top d'ajouter le nom de l'onglet en face de chaque colonne. Mais si c'est trop compliqué je m'en arrangerai. Par contre la hauteur de ligne serait 1 plus, je vais voir si je trouve des macro sur ce sujet, ce devrait être faisable.

En tout cas merci, c'est déjà super ainsi...

Merci

OK, merci. Dans le rapatriement, Faut il réserver une colonne pour les dates d'onglets?

macro proposée 'sans les dates

Sub rapatrier()   
 Voir + bas 
End Sub

reste à trouver un code pour les hauteurs de lignes

macro avec les hauteurs de ligne

Sub rapatrier() 
Dim nbre_f As Byte, cptr_f As Byte, lig_vide As Byte 
Dim nbre As Byte, cptr As Byte, lig As Byte, hauteur As Single 
Dim nonfait 

'initialisation 
Application.ScreenUpdating = False 
nbre_f = ThisWorkbook.Sheets.Count 
lig_vide = 7 
 With Sheets("A faire") 
     .Range("B7:D260").Clear 
     .Rows("7:260").RowHeight = 14 
End With 
'compilation 
For cptr_f = 2 To nbre_f - 1 
     With Sheets(cptr_f) 
          If Name <> "list" And .Name <> "A faire" Then 
               essai = .Name 
               nbre = Application.CountIf(.Range("E7:E260"), "A faire") 
               lig = 6 
               For cptr = 1 To nbre 
                    lig = .Columns("E").Find("A faire", .Cells(lig, "E")).Row 
                    hauteur = .Rows(lig).RowHeight 
                    nonfait = .Range(.Cells(lig, "B"), .Cells(lig, "D")).Value 
                    With Sheets("A faire").Cells(lig_vide, "B").Resize(1, 3) 
                         .Value = nonfait 
                         .RowHeight = hauteur 
                         .VerticalAlignment = xlTop 
                         .WrapText = True 
                    End With 
                    lig_vide = lig_vide + 1 
               Next 
          End If 
     End With 
Next 
Sheets("A faire").Range("B7:D" & lig_vide - 1).Borders.Weight = xlThin 
End Sub 

Merci Michel, je viens d'y adjoindre une macro qui ajuste la hauteur de ligne. Super et un Grand merci à toi!

voici donc la Macro finale (on verra si des modifs sont utiles après mise en prod):

Private Sub CommandButton1_Click()
Dim nbre_f As Byte, cptr_f As Byte, lig_vide As Byte
Dim nbre As Byte, cptr As Byte, lig As Byte, hauteur As Single
Dim nonfait

'initialisation
Application.ScreenUpdating = False
nbre_f = ThisWorkbook.Sheets.Count
lig_vide = 7
With Sheets("A faire")
.Range("B7:D260").Clear
.Rows("7:260").RowHeight = 14
End With
'compilation
For cptr_f = 2 To nbre_f - 1
With Sheets(cptr_f)
If Name <> "list" And .Name <> "A faire" Then
essai = .Name
nbre = Application.CountIf(.Range("E7:E260"), "A faire")
lig = 6
For cptr = 1 To nbre
lig = .Columns("E").Find("A faire", .Cells(lig, "E")).Row
hauteur = .Rows(lig).RowHeight
nonfait = .Range(.Cells(lig, "B"), .Cells(lig, "D")).Value
With Sheets("A faire").Cells(lig_vide, "B").Resize(1, 3)
.Value = nonfait
.RowHeight = hauteur
.VerticalAlignment = xlTop
.WrapText = True
End With
lig_vide = lig_vide + 1
Next
End If
End With
Next
Sheets("A faire").Range("B7:D" & lig_vide - 1).Borders.Weight = xlThin
For Each cel In ActiveSheet.UsedRange
If cel <> "" Then
Set m = cel.MergeArea
m.UnMerge
m.WrapText = True 'renvoie à la ligne
m.HorizontalAlignment = xlCenterAcrossSelection
m.Rows.AutoFit
m.Merge
m.HorizontalAlignment = xlGeneral 'facultatif bien sûr
End If
Next

End Sub

Encore merci

Geenfood

il ne reste que l'ajout dans la première colonne du nom de l'onglet d'ou sont extraites les lignes

For Each cel In ActiveSheet.UsedRange 
If cel <> "" Then 
Set m = cel.MergeArea 
m.UnMerge 
m.WrapText = True 'renvoie à la ligne 
m.HorizontalAlignment = xlCenterAcrossSelection 
m.Rows.AutoFit 
m.Merge 
m.HorizontalAlignment = xlGeneral 'facultatif bien sûr 
End If 
Next 

Très très lourd et maladroit... utilité de ce code?

Peut-être daignerais tu lire le code que je t'ai envoyé avant d'ajouter tes codes?
:o(

C'est pas la peine de s'enerver, je suis pas programmateur, j'essai de bidouiller un truc qui marche et je n'avais pas vu que ton code avait déjà le changement de heuteur de ligne...
En tout cas j'ai pris ton code tel qu'il est posté et ça fonctionne bien donc c'est parfait.

j'ai aussi essayé de changer le code afin qu'il reprenne le contenu de la première colone "num" de chaque feuille, mais sans succès...
Comme la 1ère colonne de chaque onglet comporte une cellule, ce n'est peut être pas possible de rapatrier le résultat dans la 1ère colone de l'onglet "a faire". La solution pourrait être de placer sur chaque ligne rapatriée, le nom de l'onglet d'ou vient l'info.
Aurais tu une piste?

merci, a+

C'est pas la peine de s'enerver

je ne me suis pas énervé, je suis déçu par ton attitude et surpris par ta réaction: je ne suis pas ton serviteur

donc, tu cherches tout seul

sans commentaires...

En tout cas, merci pour ce que tu as posté, ça m'a bien aidé parce que comme je te l'ai dit je n'y connais rien en programmation.
Je vais essayer de me débrouiller pour trouver le reste.