Macro pour insérer un ligne sous condition

yannick -  
Bonjour,

J'ai un fichier excel avec des données sorties d'une base de données.

En colonne A, j'ai un ordonnancement.
Exemple
1
2
3
4
6
7
8

Vous remarquez qu'on passe de 4 à 6.
Je cherche donc une macro pour insérer une ligne si les chiffres ne se suivent pas (si on passe de 4 à 6, il faut insérer une ligne entre les deux ; si on passe de 4 à 7, il faut insérer deux lignes).

Merci pour votre aide !!!

2 réponses

  1. Gyrus
    Bonsoir, 

    Sub Test()
    Dim Ligne As Long, i As Long, n As Long
        For Ligne = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
            If Range("A" & Ligne) > Range("A" & Ligne - 1) + 1 Then
                n = Range("A" & Ligne) - Range("A" & Ligne - 1) - 1
                For i = 1 To n
                    Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Next i
            End If
        Next Ligne
    End Sub


    A+
    0
    1. yannick
      Super, ca fonctionne bien. Par contre, j'ai un message
      Erreur d'exécution '13' :
      Incompatibilité de type

      Quand je fais Débogage,
      la ligne : If Range("A" & Ligne) > Range("A" & Ligne - 1) + 1 Then
      est surligné en jaune
      0
    2. Gyrus
      @yannickSi tu as un en-tête de colonne, essaie avec:
      For Ligne = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1

      A+
      0
    3. yannick
      oui, c'est même plus qu'un entête, j'ai plusieurs lignes au dessus de mon tableau à travailler
      0
    4. Gyrus
      @yannickTu dois donc limiter la boucle suivant la position de la plage de données à contrôler.
      Si la première donnée est en ligne 15 :
      For Ligne = Range("A" & Rows.Count).End(xlUp).Row To 16 Step -1

      A+
      0
  2. Mike-31
    Bonsoir,

    Un peu tard mais j'étais sur ce code qui crée la série, créer un bouton activex

    Option Explicit

    Private Sub CommandButton1_Click()
    Dim i, x As Integer
    For i = Range("A65536").End(xlUp).Row To 2 Step -1
    If Cells(i + 1, 1) > Cells(i, 1) + 1 Then
    x = Cells(i + 1, 1) - Cells(i, 1) - 1
    Rows(i + 1).Resize(x).Insert
    End If
    Next
    For i = 2 To Range("A65536").End(xlUp).Row-1
    Cells(i + 1, 1) = Cells(i, 1) + 1
    Next
    End Sub

    A+
    Mike-31

    Une période d'échec est un moment rêvé pour semer les graines du savoir.
    0