Bonsoir Christophe.
Voici mon code, du moins la partie qui nous interesse.
Bonne reception.
Patrick
Private Sub Miseajours_Click()
Application.ScreenUpdating = False
Dim counter As Long
Dim compteur As Long
Dim compt As Long
Dim count As Long
Dim derniere As Worksheet
Dim a As Variant
Dim b As Variant
Dim c As Variant
Dim d As Variant
Dim e As Variant
Dim f As Variant
Dim x As Variant
'Déclaration de mes variables
counter = 7
Worksheets(1).Activate
Worksheets(1).Cells(counter, 1).Select
'Feuille1, 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'
Loop
compteur = 0
For a = 7 To counter
'On reste sur la feuille 1
'Pour a=7 au counter ...
If Cells(a, 2).Text = "Recu Bank" Then
' Si Text est égal à "Recu Bank"
compteur = compteur + 1
'Rajouter 1 au compteur
If compteur = 2 Then
'Si compteur = 2 alors
counter = 7
Do Until Cells(counter, 2) = "Recu Bank"
counter = counter + 1
'effectuer la boucle suivante :'
'tant que la cellule repéré par le counter'
'et la colonne n'est pas = à Recu Bank,
' rajouté 1 au counter'
Loop
'Une fois la condition validée
b = counter
For c = 7 To b
Worksheets(1).Rows(c).Cut
ActiveSheet.Paste Destination:=Worksheets(3).Rows(c)
'
'Selection.PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
'SkipBlanks:=False, Transpose:=False
'ActiveSheet.Paste
'
Next c
For c = 7 To b
Worksheets(1).Rows(7).Delete Shift:=xlUp
Next c
count = 1
compt = 0
Set derniere = Sheets(Sheets.count)
derniere.Activate
derniere.Cells(count, 1).Activate
'La dernière feuille et la cellule repéré par le count'
'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 count'
'et la colonne n'est pas vide, rajouté 1 au count'
Loop
f = count - 1
'Utiliser ulterieurement pour Mise à jours Credit & Débit
'Page 1 ligne 6 ; cf pour explication :
' Mise à jours RECU Bank, colonne Crédit
For d = 1 To count
If derniere.Cells(d, 2).Text = "Recu Bank" Then
' Si Text est égal à "Recu Bank"
compt = compt + 1
If compt > 5 Then
Set NewSheet = Worksheets.Add
'Crée une nlle feuille
NewSheet.Move After:=Worksheets(Sheets.count)
'déplacer cette feuille à la fin du classeur
Set derniere = Sheets(Sheets.count)
'Sélectionner la dernière feuille
derniere.Activate
'L'activer
derniere.Range("A1").Select
Selection.ColumnWidth = 13
derniere.Range("B1").Select
Selection.ColumnWidth = 24.9
derniere.Range("C1").Select
Selection.ColumnWidth = 12.9
derniere.Range("D1").Select
Selection.ColumnWidth = 12.9
derniere.Range("E1").Select
Selection.ColumnWidth = 12.9
derniere.Range("F1").Select
Selection.ColumnWidth = 4
'Donner largeur des colonnes
count = 1
f = 1
'Utiliser ulterieurement pour Mise à jours Credit & Débit
'Page 1 ligne 6 ; cf pour explication :
' Mise à jours RECU Bank, colonne Crédit
Else
End If
Else
End If
Next d
Set derniere = Sheets(Sheets.count)
'Sélectionner la dernière feuille
derniere.Activate
'L'activer
derniere.Rows(count).Activate
'Activer la dernière ligne / count
For c = 7 To b
Worksheets(3).Rows(c).Cut
ActiveSheet.Paste Destination:=derniere.Rows(count)
count = count + 1
Next c
For c = 7 To b
Worksheets(3).Rows(7).Delete Shift:=xlUp
Next c
Set derniere = Sheets(Sheets.count)
derniere.Activate
derniere.Name = derniere.Range("A1").Text & ""
'Donner nom à la dernière feuille
'*********** Mise à jours RECU Bank, colonne Crédit ***********
'Set derniere = Sheets(Sheets.count)
'derniere.Activate
'x = count - f
'derniere.Cells(3, count).Activate
'derniere.Cells(3, count).Select
'Selection.FormulaR1C1 = "="
'ActiveCell.fomulaR1C1 = "SUM(R[-x]C:R[-1]C)"
derniere = Sheets.count
Sheets(derniere).Activate
x = count - f
Cells(3, count).fomulaR1C1 = "SUM(R[-x]C:R[-1]C)"
'*********** Routine ligne 6 Feuille 1 ***********
Worksheets(1).Activate
Worksheets(1).Rows("5:8").Select
Selection.Rows.AutoFit
e = count - 1
'Routine pour la ligne 6 de la feuille 1
'Colonne 1, copie date
Set derniere = Sheets(Sheets.count)
derniere.Activate
derniere.Cells(e, 1).Activate
derniere.Cells(e, 1).Select
Selection.Copy
'Copier la date
Worksheets(1).Select
Cells(6, 1).Select
ActiveSheet.Paste
ActiveSheet.Select
With Selection
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 12
Selection.Font.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
'colonne 2
Worksheets(1).Activate
Cells(6, 2).Select
Cells(6, 2).Value = "Report"
'inscrire dans la colonne d'à côté Report
ActiveSheet.Select
With Selection
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 12
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
End With
With Selection.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
'Copie colonne 3
Set derniere = Sheets(Sheets.count)
derniere.Activate
derniere.Cells(e, 3).Activate
derniere.Cells(e, 3).Select
Selection.Copy
Worksheets(1).Select
Cells(6, 3).Select
ActiveSheet.Paste
ActiveSheet.Select
With Selection
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 12
Selection.Font.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
'Copie colonne 4
Set derniere = Sheets(Sheets.count)
derniere.Activate
derniere.Cells(e, 4).Activate
derniere.Cells(e, 4).Select
Selection.Copy
Worksheets(1).Select
Cells(6, 4).Select
ActiveSheet.Paste
ActiveSheet.Select
With Selection
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 12
Selection.Font.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
'copie colonne 5
Set derniere = Sheets(Sheets.count)
derniere.Activate
derniere.Cells(e, 5).Activate
derniere.Cells(e, 5).Select
Selection.Copy
Worksheets(1).Select
Cells(6, 5).Select
ActiveSheet.Paste
ActiveSheet.Select
With Selection
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 12
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
End With
With Selection.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
Else
End If
End If
Next a
Worksheets(1).Activate
Application.ScreenUpdating = True
End Sub
