Microsoft 365 Macro Pour inserer 9 lignes à chaque nouveau matricule

[SEVE95]

Bonjour,
Je voudrais faire une macro qui me permette d'insérer 9 lignes à chaque nouveau matricule
Je vous remercie par avance
Bien cordialement

 

[vgendron]

Hello

un essai en PJ
il me semble que la description "à chaque NOUVEAU matricule" ne correspond pas au commentaire "inserer 9 lignes ici" dans la feuille

 

[fanch55]

Salut @ tous
Pourriez-vous préciser votre demande car comme les matricules ne sont pas triés et qu'il y a de 1 ligne à 67 lignes par matricule unique, les 9 lignes à ajouter sont pour qui ?

 

[SEVE95]

Bonjour,
En fait ils ont le même matricule mais le centre consommateur différent
Donc à chaque matricule et code consommateur différent je veux insérer 9 Lignes
Merci beaucoup pour votre retour

 

[Phil69970]

Bonjour à tous

Vincent pourquoi une 2eme boucle il me semble que l'on peut le faire avec une seule boucle et arrêter la boucle à 4 au lieu de 3

For i = LastLine To 4 Step -1

Sub InsererEntreChaqueligne()
Application.ScreenUpdating = False
Dim i&, LastLine&
With ActiveSheet
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = LastLine To 4 Step -1
        If .Range("A" & i) <> .Range("A" & i - 1) Then
            .Rows(i & ":" & i + 9).Insert
'            For j = 1 To 9
'                .Rows(i).Insert
'            Next j
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "OK"
End Sub

 

[vgendron]

suite à la remarque de fanch55 (hello)
j'ai ajouté un tri

 

[vgendron]

Bonjour à tous

Vincent pourquoi une 2eme boucle il me semble que l'on peut le faire avec une seule boucle et arrêter la boucle à 4 au lieu de 3

Sub InsererEntreChaqueligne()
Application.ScreenUpdating = False
Dim i&, LastLine&
With ActiveSheet
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = LastLine To 4 Step -1
        If .Range("A" & i) <> .Range("A" & i - 1) Then
            .Rows(i & ":" & i + 9).Insert
'            For j = 1 To 9
'                .Rows(i).Insert
'            Next j
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "OK"
End Sub

Hello Phil

pourquoi une seconde boucle.. parce que je me pose systématiquement la question de "comment inserer x lignes d'un coup"
et pour s'arreter à 4 au lieu de 3.. effectivement

 

[Cousinhub]

Hello Phil

pourquoi une seconde boucle.. parce que je me pose systématiquement la question de "comment inserer x lignes d'un coup"
et pour s'arreter à 4 au lieu de 3.. effectivement

Hello,
Ou ainsi :

.Rows(i).Resize(9).Insert

Bonne journée

 

[SEVE95]

J'ai essayé la macro, mais elle me l'exécute que pour le premier matricule Je voudrais qu'elle me le fasse Jusqu'au matricule ligne 509 qui ferait au moins 5000 lignes Merci par avance

 

[vgendron]

J'ai essayé la macro, mais elle me l'exécute que pour le premier matricule Je voudrais qu'elle me le fasse Jusqu'au matricule ligne 509 qui ferait au moins 5000 lignes Merci par avance

étrange.. chez moi, avec ton fichier, elle s'execute correctement...

 

[vgendron]

tu parles de 5000 lignes.. j'en déduis que finalement, ce n'est pas entre chaque NOUVEAU matricule mais bien entre CHAQUE ligne

Sub InsererEntreChaqueligne()
    Application.ScreenUpdating = False
    With ActiveSheet 'avec la feuille active
        LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne non vide de la colonne A
       
        Set zone = .Range("A2:F" & LastLine) 'on définit le tableau complet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=zone.Columns(1).Offset(1, 0), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on créé le tri sur la colonne A
        With .Sort 'on applique le tri
            .SetRange zone
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        For i = LastLine To 4 Step -1 'pour toutes les lignes en partant du bas
            'If .Range("A" & i) <> .Range("A" & i - 1) Then 'si on a deux matricules différents
                .Rows(i).Resize(9).Insert
            'End If
        Next i
    End With
    Application.ScreenUpdating = True
    MsgBox "OK"
End Sub

 

[Phil69970]

Re

En plus court pour le tri

Sub InsererEntreChaqueligne()
Application.ScreenUpdating = False
With ActiveSheet 'avec la feuille active
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne non vide de la colonne A
   .Range("A2:F" & LastLine).Sort Key1:=Range("A2:F" & LastLine), Order1:=1, Header:=xlYes, DataOption1:=xlSortNormal 'xlSortTextAsNumbers
    For i = LastLine To 4 Step -1 'pour toutes les lignes en partant du bas
        If .Range("A" & i) <> .Range("A" & i - 1) Then 'si on a deux matricules différents
            '.Rows(i & ":" & i + 9).Insert
            .Rows(i).Resize(9).Insert 'ou en version plus élégante de Cousinhub  ; )
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "OK"
End Sub

Et même remarque que Vincent

chez moi, avec ton fichier, elle s'execute correctement...

Ou alors il nous manque une info ......

 

[SEVE95]

Merci pour votre retour,
J'ai copié la macro dans visual basic et en l'éxécutant j'ai ce message

 

[vgendron]

le message me semble assez clair non??
il faut accepter l'activation des macros à l'ouverture du classeur.. (enregistré au format xlsm)

 

[SEVE95]

Oui je l'ai fait