Inserer une ligne au changement de valeur

Nicolas -  
 Nicolas -
Bonjour,

J'ai modifié une macro que j'ai récupéré sur le net pour l'adapter à mon besoin et c'est quasiment bon.

la voici;
Sub Extraction()
t = Timer
Dim i&, Premier&, Ncol&, ColCritère&, n&
Dim derligne&, totalligne&
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets.Add Before:=Sheets(1)
Sheets("BD").[A1].CurrentRegion.Copy [A1]
Set f = Sheets(1)
Ncol = 9 ' Adapter ou Ncol=f.[A1].CurrentRegion.Columns.Count
ColCritère = 2 ' adapter
Derlig = f.[a65000].End(xlUp).Row
Sheets("BD").[A1].CurrentRegion.Copy [A1]
Set Rng = f.Cells(2, 1).Resize(Derlig, Ncol)
Rng.Sort key1:=f.Cells(2, ColCritère)
TblCrit = f.Cells(2, ColCritère).Resize(Derlig - 1)
i = 1: Premier = 1
n = UBound(TblCrit)
Do While i <= n
code = TblCrit(i, 1)
Do While TblCrit(i, 1) = code
i = i + 1: If i > n Then Exit Do
Loop
On Error Resume Next: Sheets(code).Delete: On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = code
f.Cells(1 + Premier, 1).Resize(i - Premier, Ncol).Copy [A2]
f.Cells(1, 1).Resize(, Ncol).Copy [A1]
' Total Durée
derligne = Cells(65347, 1).End(xlUp).Row
totalligne = derligne + 1
Range("E" & totalligne).Formula = "=SUM(E2:E" & derligne & ")"
Range("F" & totalligne).Formula = "=SUM(F2:F" & derligne & ")"
Range("G" & totalligne).Formula = "=SUM(G2:G" & derligne & ")"
Range("H" & totalligne).Formula = "=SUM(H2:H" & derligne & ")"
Premier = i
Loop
Sheets(1).Delete
MsgBox Timer() - t
End Sub

Pour expliquer le fonctionnement, j'integre des valeurs dans ma feuille bd.
ensuite ma macro copie les données de chaque ligne dans un onglet, en créant un onglet par valeur de ma colonne B (a savoir un nom). puis je fais des totaux en bas de tableau.
organisation des colonnes : A= Date B=Nom C= donnée 1...

je souhaiterai ajouter à ma macro l'ajout d'une ligne vide entre chaque changement de valeur de ma colonne A soit à chaque changement de date.

ce qui fait dans chaque onglet mes données seront regroupées par Nom, et dans chaque onglet un ligne vide sépare les journées.


01/01/2016 | MICHEL | Paris
01/01/2016 | MICHEL | CERGY

02/01/2016 |MICHEL | REIMS
02/01/2016 |MICHEM |LAON
...

En relisant mon post j'ai l'impression de parler Chinois, mais je ne l'espere pas ^^.

Merci pour vos réponses.


A voir également:

2 réponses

Réponse 1 / 2
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour 
    For i = 3 To [A10000].End(xlUp).Row
        If Cells(i - 1, 1) <> Cells(i, 1) Then
            Cells(i, 1).EntireRow.Insert
            i = i + 1
        End If
    Next i

A placer au bon endroit dans votre code
Cdlt
0
Réponse 2 / 2
Nicolas
 
Merci Beaucoup Frenchie83.

je l'ai intégré et cela fonctionne parfaitement.
0