[Resolu] Trois feuilles à synthétiser dans une 4 éme avec tri par date

[greg63]

Bonjour,

J'ai trois feuilles Excel avec la même mises en forme.

Je souhaiterais que mes feuille "Au" "Nan" et "Lore" s'ajoute dans la feuille final et qu'un tri s'opére en fonction de la date.

J'ai cherché des solutions (j'en ai trouvé une qui pouvait me plaire) mais j'ai du mal a utilisé du VBA.

Je vous laisse en pièce jointe le tableau

Je vous remercie de l'aide que vous pourriez m'apporter

 

[job75]

Re : Trois feuilles à synthétiser dans une 4 éme avec tri par date

Bonjour greg63,

Code à placer dans la feuille Final (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim ncol%, feuille, lig&, f, t
ncol = 4 'nombre de colonnes
feuille = Array(Feuil1, Feuil2, Feuil3) 'CodeNames des feuilles à copier
Application.ScreenUpdating = False
Rows("2:" & Rows.Count).Delete 'RAZ
lig = 2 '1ère ligne à renseigner
For Each f In feuille
  t = Intersect(f.UsedRange.Offset(1).EntireRow, f.[A:A].Resize(, ncol + 1))
  Cells(lig, 1).Resize(UBound(t), ncol) = t
  lig = lig + UBound(t)
Next
[A:A].Resize(, ncol).Sort Columns(ncol), xlAscending, Header:=xlYes 'tri
End Sub

La macro s'exécute quand on active la feuille.

A+

 

[job75]

Re : Trois feuilles à synthétiser dans une 4 éme avec tri par date

erreur de fil

 

[job75]

Re : Trois feuilles à synthétiser dans une 4 éme avec tri par date

Bonjour greg63, le forum,

Ceci est plus simple :

Private Sub Worksheet_Activate()
Dim col%, feuille, lig&, f
col = 4 'colonne des dates
feuille = Array(Feuil1, Feuil2, Feuil3) 'CodeNames des feuilles à copier
Application.ScreenUpdating = False
Rows("2:" & Rows.Count).Delete 'RAZ
lig = 2 '1ère ligne à renseigner
For Each f In feuille
  f.UsedRange.Offset(1).Copy Cells(lig, 1)
  lig = lig + f.UsedRange.Rows.Count - 1
Next
Me.UsedRange.Sort Columns(col), xlAscending, Header:=xlYes 'tri
End Sub

A+

 

[greg63]

[Resolu] Re : Trois feuilles à synthétiser dans une 4 éme avec tri par date

Bonjour greg63, le forum,

Ceci est plus simple :

Private Sub Worksheet_Activate()
Dim col%, feuille, lig&, f
col = 4 'colonne des dates
feuille = Array(Feuil1, Feuil2, Feuil3) 'CodeNames des feuilles à copier
Application.ScreenUpdating = False
Rows("2:" & Rows.Count).Delete 'RAZ
lig = 2 '1ère ligne à renseigner
For Each f In feuille
  f.UsedRange.Offset(1).Copy Cells(lig, 1)
  lig = lig + f.UsedRange.Rows.Count - 1
Next
Me.UsedRange.Sort Columns(col), xlAscending, Header:=xlYes 'tri
End Sub

A+

Merci enormement en plus la mise à jour s'automatise a chaque nouvelle entrée de valeur.

Tu es au top