Inserer une ligne au changement de valeur [Fermé]

Signaler
-
 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.


2 réponses

Messages postés
2169
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
22 octobre 2020
293
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
Merci Beaucoup Frenchie83.

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