Inserer une ligne au changement de valeur

Fermé
Nicolas - 12 mai 2016 à 18:01
 Nicolas - 13 mai 2016 à 10:32
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

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
13 mai 2016 à 05:54
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
Merci Beaucoup Frenchie83.

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