Insertion/suppression de ligne via VBA [Résolu]

[Anais51]

Bonjour à tous,

J'ai eu quelques bases de VBA mais il me manque trop de morceaux (1 an sans s'y remettre on oublie tout) et je cherche à faire une boucle conditionnel mais je ne sais plus y mettre les termes.

La boucle commence en A4.

=> Je regarde A4
-> Si A4 <> "FIN"
alors on regarde B4
-> Si B4 = X
Alors on insert X lignes deux lignes plus bas (donc en ligne 6) et on copie le rang juste en bas (donc la ligne 5) dans ces X lignes inséré. (En gros si en B4 il est écrit 5 je veux insérer 5 lignes de la ligne 6 à 11 avec les mêmes formules que la ligne 5)
-> Si B4 = - X
Alors on supprime X lignes dans la ligne du bas (donc dès la ligne 5, ainsi si dans la cellule j'ai -3 je supprime les lignes 5, 6 et 7)
-> Si B4 = Vide
On ne fait rien.

Et on reprend en A5

La boucle s'arrête quand une cellule de la colonne A contient "FIN" (et il n'est écrit que ce mot là dans la cellule).

Merci pour votre aide!

 

[JBARBE]

Re : Insertion/suppression de ligne via VBA

Bonsoir à tous,

Désolé du vrai charabia ton exposé !!

Que veux-tu vraiment parce que une boucle dans ces conditions ne peux jamais être faite !

Bonne soirée quand même !

 

[tototiti2008]

Re : Insertion/suppression de ligne via VBA

Bonsoir Anais51, Bonsoir JBARBE,

Cousine de Pastis ? Désolé

Un essai avec ce que j'ai compris

Sub test()
Dim i As Long, Nb As Long, NbCol As Long
    With ActiveSheet
    NbCol = .UsedRange.Columns.Count
    i = 4
    Do Until UCase(.Cells(i, 1).Value) = "FIN"
        Nb = .Cells(i, 2).Value
        If Nb > 0 Then
            .Range(.Cells(i + 2, 1), .Cells(i + 2 + Nb - 1, 1)).EntireRow.Insert
            .Range(.Cells(i + 1, 1), .Cells(i + 1, NbCol)).AutoFill Destination:=.Range(.Cells(i + 1, 1), .Cells(i + 2 + Nb - 1, NbCol))
            i = i + Nb + 1
        ElseIf Nb < 0 Then
            .Range(.Cells(i + 1, 1), .Cells(i - Nb, 1)).EntireRow.Delete
        End If
        i = i + 1
    Loop
    End With
End Sub

 

[Anais51]

Re : Insertion/suppression de ligne via VBA

Aucun rapport avec le pastis mais un avec la marne.

En gros j'ai des cellules qui peuvent se trouver dans des endroits différents de la colonnes B qui vérifient le nombre de lignes qu'il doit y avoir sous un "chapitre". Elles affichent alors le nombre de lignes manquantes ou en trop. Manuellement jusqu'ici on supprimai ou ajoutai des lignes avec les formules de la ligne juste au dessus. Maintenant je veux l'automatiser.
Il y a un problème de type sur ta macro toto.

Merci en tout cas pour votre aide je vais voir pour modifier et adapter la macro que toto m'a donné.

 

[Anais51]

Re : Insertion/suppression de ligne via VBA

Re-bonjour!

Alors n'arrivant pas à modifier la macro de toto pour faire ce que je voulais, j'ai simplifié mes besoins (plus besoin de FIN je regarde sur 400 cellules) et repris des bouts pour en refaire une:

Sub Test()
Dim i As Integer, y As Integer


Sheets("3-PAR DIRECTION MOE-MOA").Select


y = Cells(i, 1).Value
For i = 4 To 400 ' Regarde les celules de 4 à 400
If y > 0 Then ' Si la celule est supérieur à zéro
' On insert le nombre de lignes indiquées dans la celule deux lignes plus bas
.Rows(Cells(i + 2, 1), Cells(i + 2 + y - 1, 1)).EntireRow.Insert
' On copie les formules de la ligne juste en dessous de la celule testé
' dans les lignes fraichement insérées
.Rows(i + 1, i + 1).AutoFill Destination:=Rows(i + 1, i + 1 + y)
ElseIf y < 0 Then 'Si la celule est inférieur à zéro
' On supprime le nombre de lignes indiquées dans la celule
' juste en dessous de la celule en question
.Range(.Cells(i + 1, 1), .Cells(i + 1 - y, 1)).EntireRow.Delete
End If
Next i 'Regarde la celule suivante
End Sub

Mais j'ai une erreur de référence sur la ligne en rouge.
Quelqu'un peut m'aider?

Merci par avance!

 

[Anais51]

Re : Insertion/suppression de ligne via VBA

Je viens d'y passer ma journée mais au final j'ai réussi avec ça: (Je le met pour ceux qui passeraient par là )

Sub Test()
Dim i As Integer
Dim y As Integer


    Sheets("3-PAR DIRECTION MOE-MOA").Select

   
    For i = 4 To 400 ' Regarde les cellules de 4 à 400
        y = Cells(i, 1).Value 'y correspond à la valeur dans la ligne i de la colonne A
        If y > 0 Then ' Si la cellule est supérieur à zéro
        ' On insert le nombre de lignes indiquées dans la cellule deux lignes plus bas
        ' Pour cela on sélectionne deux cellules auxquelles on demande d'insérer une ligne entière
            
            Range(Cells(i + 2, 1), Cells(i + 1 + y, 1)).EntireRow.Insert
            'Rows(i + 2, i + 2 + y).Insert xlShiftDown
        
        ' On copie les formules de la ligne juste en dessous de la celule testé
        ' Dans les lignes fraichement insérées. Vu que je n'arrive pas à faire la ligne entière
        ' Je sélectionne la copie de 90 colonnes.
        
            
            Range(Cells(i + 1, 1), Cells(i + 1, 90)).AutoFill Destination:=Range(Cells(i + 1, 1), Cells(i + 1 + y, 90))
           
            
        ElseIf y < 0 Then 'Si la cellule est inférieur à zéro
        ' On supprime le nombre de lignes indiquées dans la cellule
        ' Juste en dessous de la cellule en question
            
            Range(Cells(i + 1, 1), Cells(i - y, 1)).EntireRow.Delete
           
        
        
        
        End If
    Next i 'Regarde la cellule suivante
End Sub

Merci pour tout Toto!