Option Explicit
Sub Recap()
Dim Ligne As Long, LigneCopie As Long
Dim Groupe As Integer
For Ligne = PremiereLigne("Feuil1", "Mois") To DerniereLigne("Feuil1", True)
For Groupe = 1 To 3
If Worksheets("Feuil1").Range("B" & Ligne).Offset(0, Groupe * 2) <> "" Then
LigneCopie = DerniereLigne("Recap", False) + 1
Worksheets("Feuil1").Range("A" & Ligne & ":C" & Ligne).Copy Worksheets("Recap").Range("A" & LigneCopie & ":C" & LigneCopie)
Worksheets("Feuil1").Range("B" & Ligne).Offset(0, Groupe * 2).Copy Worksheets("Recap").Range("D" & LigneCopie)
Worksheets("Feuil1").Range("C" & Ligne).Offset(0, Groupe * 2).Copy Worksheets("Recap").Range("E" & LigneCopie)
End If
Next Groupe
Next Ligne
End Sub
Function DerniereLigne(Feuille As String, Securite As Boolean) As Long
Dim InterLigne As Long
InterLigne = Worksheets(Feuille).Range("A" & Rows.Count).End(xlUp).Row
If InterLigne > 1 Or Not Securite Then
DerniereLigne = InterLigne
Else
MsgBox "Pas de donnée à traiter, fin du traitement"
End
End If
End Function
Function PremiereLigne(Feuille As String, Libelle As String) As Long
Dim Trouve As Range
Set Trouve = Worksheets(Feuille).Range("A:A").Find(Libelle, lookat:=xlWhole)
If Not Trouve Is Nothing Then
PremiereLigne = Trouve.Row + 1
Else
MsgBox "Elément : " & Libelle & " non truvé, Arrêt du traitement"
End
End If
End Function
