Incrémentation avec insertion de cellules par lots

Bonjour à Tous,

Je suis depuis plusieurs jours sur un problème que je n'arrive pas à solutionner.

Un éclaircissement de votre part serait merveilleux.

Je souhaite obtenir le résultat suivant dans ma feuille 2 sous forme de lignes (les tirets sont des tabulations) :

1-2-3-4-5-6-7-8-9-10-0-0-0-11-12-13-14-15-16-17-18-19-20-0-0-0...1000

Soit mes cellules suivantes dans ma Feuille 1 :

A1 = Premier numéro à Incrémenter (dans l'exemple c'est 1 mais ça peut varier et commencer par 100)

A2 = Dernier numéro à incrémenter (ici c'est 1000 mais ça peut être 30000)

A3 = Nombre de 0 que je souhaite entre chaque série (ici 3)

A4 = La taille de mes séries (ici de 10).

et petite cerise sur le gâteau, si les 0 entre chaque série peuvent indiquer les valeurs comprises dans la série précédente, du style :

1-2-3-4-5-6-7-8-9-10-1a10-1a10-1a10-11-12-... ce serait le luxe ultime.

J'ai d'abord tenté d'incrémenter mes lignes de 1 à 1000 (selon les infos renseignées en A1 et A2) et ensuite insérer des lignes blanches toutes les A4 lignes. Mais je ne crois pas que ça soit la meilleure des solutions car je n'arrive pas à insérer le nombre de lignes correspondant à ma cellule A3 et je pense qu'il doit y avoir une procédure plus efficace.

Quelle serait la meilleure méthode pour vous ?

Je vous remercie 1000 fois d'avance...

Bonjour,

petit défi amusant !

Le code :

Sub LRD()
    deb = 1
    cpt = [A1]
    ligne = 1
    For i = 1 To ([A2] / [A4])
        For j = 1 To [A4]
            Cells(ligne, 3) = cpt
            cpt = cpt + 1 + 10 * (([A4] / 10) - 1)
            ligne = ligne + 1
        Next j
        For j = 1 To [A3]
            Cells(ligne, 3) = deb & " à " & cpt - 1
            ligne = ligne + 1
        Next j
        deb = cpt
    Next i
End Sub

Attention ! Cela ne marche que pour ces données, s'il faut que cela devienne "variable" alors il faut que je me repenche sur le code

@ bientôt

LouReeD

Je reste sans voix...

J'ai passé au moins 15h dessus en testant 1000 solutions compliquées...

et en 15 min et 15 lignes... c'est réglé.

Quand je vois le code ça me paraît logique. Mais c'est un métier.

Merci 1000 fois LouReeD, tu m'as été d'une aide précieuse.

Béné.

Au départ c'était surtout pour recevoir les 1000 mercis !

Merci @ vous de vos remerciements, donc !

Faut-il que le code devienne "variable" ?

@ bientôt

LouReeD

Je l'ai légèrement adapté afin d'obtenir exactement ce que je souhaite.

Sub LRD()
    deb = [A1]
    cpt = [A1]
    ligne = 1
    For i = 1 To ([A6])
        For j = 1 To [A4]
            Worksheets("Feuil2").Cells(ligne, 2) = [A8]
            Worksheets("Feuil2").Cells(ligne, 1) = cpt
            cpt = cpt + 1
            ligne = ligne + 1
        Next j

        For j = 1 To [A3]
            Worksheets("Feuil2").Cells(ligne, 1) = " Numéros précédents de " & deb & " à " & cpt - 1
            ligne = ligne + 1
        Next j
        deb = cpt
    Next i

End Sub

N'étant pas une pro de la sémantique VBA, je ne sais pas si ce que j'ai fait est correcte mais j'obtiens exactement ce que je veux. Le but étant ensuite d'exporter cette feuille en format .CSV et de l'importer dans Indesign en fusion de données me permettant d'incrémenter des pages.

Je suis ravie...

Encore merci et à bientôt,

Je vous propose la version "variable" qui corrige d'éventuelles erreurs si vous deviez modifier une valeur :

Sub LouReeD()
    Dim Deb, Fin, Inc, Plage, Nb, I, J, DP, FP, Ligne, Cpt
    Range("C:C").ClearContents
    Deb = [_DEB]
    Fin = [_FIN]
    Inc = [_INC]
    Plage = [_PLAGE]
    Nb = [_NB]
    Ligne = 1
    Cpt = Deb
    DP = Deb
    FP = DP + (Plage * Inc) - 1
    Do
        DoEvents
        For I = 1 To Plage
            Cells(Ligne, 3) = Cpt
            Cpt = Cpt + Inc
            Ligne = Ligne + 1
        Next I
        For I = 1 To Nb
            Cells(Ligne, 3) = DP & " à " & DP + ((Plage - 1) * Inc)
            Ligne = Ligne + 1
        Next I
        DP = Cpt
        FP = DP + (Plage * Inc) - 1
        If Cpt >= Fin Then Exit Do
    Loop
End Sub

Le fichier :

@ bientôt

LouReeD