Problème d'itérations

[PF]

Bonjour à tous, voici mon problème

Sur ma feuille de calcul, régulièrement une même données apparait "Recu Bank", j'aimerai que lorsque mon utilisateur appuit sur le bouton Actualisé, il ne reste dans mon tableau qu'une période. J'aimerai que le reste aille sur une feuille nommé 3 (par exemple), (Nb : Jusque là, mon code fonctionne).
Mais j'aimerai également que sur la feuille 3 n'apparaisse que 6 périodes et qu'à chaque fois qu'il y ai un laps de temps de 6 périodes on crée une autre feuille et ainsi de suite. (Nb : C'est sur cette partie que j'ai un problème). Vous trouverez ci dessous mon code.

Merci à tous ceux qui y jetteront un coup d'oeil.
Patrick

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

Dim counter As Long
Dim compteur As Long
Dim compteurb As Long
Dim count As Long
Dim derniere As Worksheet

counter = 6
Worksheets(1).Activate
Worksheets(1).Cells(counter, 1).Select
'Feuille3, cellule repéré par le counter'
'et la colonne 1, sont active'
Do Until Cells(counter, 1) = ""
counter = counter + 1
'effectuer la boucle suivante :'
'tant que la cellule repéré par le counter'
'et la colonne n'est pas vide, rajouté 1 au'
'counter'

Dim a As Variant
Dim b As Variant
Dim c As Variant
Dim d As Variant

Loop
compteur = 0
For a = 6 To counter
If Cells(a, 1).Text = "Recu Bank" Then
' Si Text est égal à "Recu Bank"
compteur = compteur + 1
If compteur = 2 Then
counter = 6
Do Until Cells(counter, 1) = "Recu Bank"
counter = counter + 1
Loop
b = counter
For c = 6 To b
Worksheets(1).Rows(c).Cut
ActiveSheet.Paste Destination:=Worksheets(2).Rows(c)
Next c
For c = 6 To b
Worksheets(1).Rows(6).Delete Shift:=xlUp
Next c
Else
End If
End If
Next a

count = 1
compteurb = 0
Set derniere = Sheets(Sheets.count)
derniere.Activate
derniere.Cells(count, 1).Activate
'La dernière feuille et la cellule repéré par le counter'
'et la colonne 1, sont active'
Do Until derniere.Cells(count, 1) = ""
count = count + 1
'effectuer la boucle suivante :'
'tant que la cellule repéré par le counter'
'et la colonne n'est pas vide, rajouté 1 au counter'
Loop

For d = 1 To count
If Cells(d, 1).Text = "Recu Bank" Then
' Si Text est égal à "Recu Bank"
compteurb = compteurb + 1
If compteurb = 4 Then
Set NewSheet = Worksheets.Add
NewSheet.Move After:=Worksheets(Sheets.count)

'Regarder ce qui se passe au dessus et voir ce
'qui déconne en dessous. Pf


Else
End If
Else
End If
Next d
Set derniere = Sheets(Sheets.count)
derniere.Activate
For c = 6 To b
Worksheets(2).Rows(c).Cut
ActiveSheet.Paste Destination:=derniere.Rows(count)
count = count + 1
Next c
For c = 6 To b
Worksheets(2).Rows(6).Delete Shift:=xlUp
Next c

Worksheets(1).Activate
Application.ScreenUpdating = True
End Sub