VBA copier les 5 prochaines lignes pleines et 1st ligne varariables

[manautop]

onjour,

Je viens encore vers vous car je n'arrive plus à avancer sur ma macro (merci pour toute l'aide déjà apporté)

alors voilà j'ai deux pages
la feuil2 contient en colone toutes les dates de l'année, la première partie de ma macro sert donc à trouver la ligne de la date du jour.

et c'est la que ça se complique,

il faudrait que la seconde partie de la macro demarre à partir de cette ligne trouvé et copie colle les 5 prochaines plages non vide (exemple B11) sur les les lignes B4:B9 de la feui1... avec pour référence pour vérifier si la plage est vide ou pas la colonne C...

j'arrive donc à copier toutes les lignes non vide de la colonne C mais si je lance la macro 2 fois de suite au lieu d'effacer les lignes B4:B9 de la Feuil1 la macro réécrit tout en dessous...je vois pourquoi dans le code pourquoi elle fait ça, mais je ne connais pas d'autre moyen

si vous avez une petite idée, une piste pour m'aider je suis preneur




Sub ChercheDate()
Dim Nbre As Integer, Lig As Integer
Dim Col_B As Range, DCLB As Integer
Dim cellule As Range
Dim Ligne As String

With Worksheets("Feuil2")
'Derniere cellule colonne B
DCLB = .Range("B" & Rows.Count).End(xlUp).Row
'Definition Plage a Tester en memoire (plus rapide)
Set Col_B = .Range("B2:B" & DCLB)
'Recherche si Date du jour existe
If Application.CountIf(Col_B, Date) > 0 Then 'Oui
'Recherche ligne de l'info
Lig = .Columns("B").Find(Date, .Cells(1, "B"), , xlWhole).Row
'Ecriture ligne de l'info trouvee
Range("a1").Value = Lig
Else 'Non
MsgBox "Pas Trouvé"
End If
End With



For Each cellule In Worksheets("post FB").Range("C1:C400")
If Not IsEmpty(cellule) Then
If IsEmpty(Worksheets("What's next").Range("B65536").End(xlUp)) Then
Worksheets("What's next").Range("B65536").End(xlUp).Select
cellule.Delete Worksheets("What's next").Range("B4:B9")
Else
Ligne = Worksheets("What's next").Range("B65536").End(xlUp).Row
Range("B" & Ligne + 1).Select
cellule.Copy Worksheets("What's next").Range("B" & Ligne + 1)
End If
End If
Next cellule
End Sub




Merci d'avance.