Macro pour insérer automatiquement une ligne vide

[frenchyboy2015]

Bonjour,


J'ai tenté, sans succès, de créer une macro pour insérer une ligne vide lorsque le numero de certificat (colonne A) change, c-a-d insérer une ligne vide entre chanque numéro de certificat différent.


Par exemple, dans le fichier ci-joint, j'aimerais qu'une ligne vide s'ajoute entre les lignes 3-4, 7-8, 10-11, etc...


Merci a l'avance pour votre aide et/ou conseil,


Frenchyboy

 

[DoubleZero]

Bonjour, frenchyboy2015, le Forum,

Comme ceci ?

Option Explicit
Sub Ligne_insérer()
    Dim i As Long
    Application.ScreenUpdating = False
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    For i = Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
        If Range("a" & i) <> Range("a" & i - 1) Then Range("a" & i).EntireRow.Insert
    Next i
    Range("a2:d2").Interior.ColorIndex = xlNone
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[frenchyboy2015]

Bonjour, frenchyboy2015, le Forum,

Comme ceci ?

Option Explicit
Sub Ligne_insérer()
    Dim i As Long
    Application.ScreenUpdating = False
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    For i = Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
        If Range("a" & i) <> Range("a" & i - 1) Then Range("a" & i).EntireRow.Insert
    Next i
    Range("a2:d2").Interior.ColorIndex = xlNone
    Application.ScreenUpdating = True
End Sub

A bientôt

Wow merci DoubleZero c'est très apprécié!!!!

Peux-tu me conseiller sur des sites internet / lectures pour que je puisses m'améliorer ma programmation VBA?

Encore merci,

Frenchyboy

Merci

 

[DoubleZero]

Re-bonjour,

- user, abuser de l'enregistreur de macros ;

- fréquenter XLD ;

- consulter cette discussion.

Bon courage et à bientôt

 

[frenchyboy2015]

Re-bonjour,

- user, abuser de l'enregistreur de macros ;

- fréquenter XLD ;

- consulter cette discussion.

Bon courage et à bientôt

Merci pour cette information, je vais m'en servir pour tenter de parfaire mes connaissances VBA

Si je peux permettre d'utiliser tes connaissances approfondies, tu trouveras dans le fichier ci-joint le résultat final, pour les 2 premiers cas, que je recherche.

Sans vouloir abuser, je te serai reconnaissant si tu peux me guider sur le chemin à prendre pour résoudre mon problème.

Je cherche à trouver la façon de coder ceci;
1- en colonne D, lorsque la cellule i est vide, fait la somme de i-1 jusqu'à la prochaine ligne vide
2- en colonne E, calculer la proprotion de chaque montant i (de la colonne D) par rapport au total trouvé ci-haut

Je vais comprendre si tu hésites à m'aider, car ce n'est pas à toi à faire tout le travail pour moi!

Merci à l'avance,

Ton ami Frenchyboy

 

[DoubleZero]

Bonjour, frenchyboy2015, le Forum,

... 2- en colonne E, calculer la proprotion de chaque montant i (de la colonne D) par rapport au total trouvé ci-haut...

Je ne parviens pas à traiter le point 2. Un autre membre saura certainement trouver une solution.

A bientôt

 

[job75]

Bonjour frenchyboy2015, chère ânesse,

Je ne parviens pas à traiter le point 2. Un autre membre saura certainement trouver une solution.

J'ai juste complété la macro Sous_total_insérer en entrant la formule =Pourcent() en colonne E .

Le code de la fonction :

Function Pourcent()
Application.Volatile
Dim i&, j As Variant
Pourcent = ""
i = Application.Caller.Row
'If Cells(i, 1) Like "Total*" Then Exit Function 'si l'on ne veut pas des 100%
j = Application.Match("Total*", Range("A" & i & ":A" & Rows.Count), 0)
On Error Resume Next 'si le calcul n'est pas possible
Pourcent = Cells(i, 4) / Cells(i + j - 1, 4)
End Function

Fichier joint.

A+

 

[DoubleZero]

Re-bonjour, bonjour cher jb75,

... J'ai juste complété la macro Sous_total_insérer en entrant la formule =Pourcent() en colonne E ...

Gros MERCI et grand BRAVO, job75.

A bientôt

 

[job75]

Re,

On peut bien sûr supprimer les formules en ne conservant que les valeurs :

    With [A1].CurrentRegion.Columns(5)
      .Formula = "=Pourcent()": .Cells(1) = "%": .Value = .Value
    End With

Fichier (2).

A+

 

[frenchyboy2015]

Merci à vous 2 de m'aider à tenter de comprendre et de m'avancer dans le monde de la programmation de macro!

Je vais paraître débutant....mais je suis incapable d'ouvrir vos fichers.

Pouvez-vous me guider?

Merci bien,

Frenchyboy

 

[DoubleZero]

Bonjour, frenchyboy2015, job75 , le Forum,

... je suis incapable d'ouvrir vos fichers...

Un message apparaît-il ?

A bientôt

 

[job75]

Bonjour frenchyboy2015, chère ânesse, le forum,

Il ne faut pas essayer d'ouvrir le fichier en ligne, il faut d'abord le télécharger.

Clic droit sur le nom du fichier => Enregistrer la cible du lien sous...

A+

 

[frenchyboy2015]

Je n'ai accès qu'à la version office 2003. Je ne peux donc l'ouvrir qu'en lecture seulement et je n'ai pas accées aux macros.

Pouvez-vous simplement m'envoyer les codes VBA et je les insérerai dans mon fichier?

Encore merci pour votre aide précieuse!!!

Votre ami Frenchyboy

 

[DoubleZero]

Bonjour, frenchyboy2015, job75 , le Forum,

Je n'ai accès qu'à la version office 2003. Je ne peux donc l'ouvrir qu'en lecture seulement et je n'ai pas accées aux macros...

Il serait préférable de le préciser dans le "profil".

Voici les codes :

Option Explicit
Sub Sous_total_insérer()
    Dim c As Range, i As Long
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    On Error Resume Next
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    With Range("a:d")
        .RemoveSubtotal
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), Replace:=True, SummaryBelowData:=True
        .ClearOutline
    End With
    For Each c In Columns(4).SpecialCells(xlCellTypeFormulas, 23)
        c(, -2).Resize(, 5).Interior.Color = 15395046
        c(, -2).Resize(, 5).Font.Bold = True
    Next
    [E:E] = "" 'RAZ
    [A1].CurrentRegion.Columns(5) = "=Pourcent()": [E1] = "%"
    Columns.AutoFit
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

Function Pourcent()
Application.Volatile
Dim i&, j As Variant
Pourcent = ""
i = Application.Caller.Row
'If Cells(i, 1) Like "Total*" Then Exit Function 'si l'on ne veut pas des 100%
j = Application.Match("Total*", Range("A" & i & ":A" & Rows.Count), 0)
On Error Resume Next 'si le calcul n'est pas possible
Pourcent = Cells(i, 4) / Cells(i + j - 1, 4)
End Function

A bientôt