XL 2016 incrémentation base de données vba avec supression en partie de la ligne

RobyL

XLDnaute Nouveau
Bonjour,

je souhaiterais que la ligne que j'incrémente dans ma base de données s'éfface une fois stocker.
j'ais le code ci-dessous qui fonctionne en partie.
sauf que ça beugue lorsque la ligne doit s'effacer.
=> le petit chlalenge c'est que les colonnes F, G et I ne doivent pas s"effacer

voici le code :

Sub Traitement2()

derligne = Sheets("BASE DE DONNEES").Range("A65535").End(xlUp).Row + 1
ligneOK = ""
I = 2

Do While I < Range("A65535").End(xlUp).Row + 1

If Range("L" & I) = "OK" Then
Sheets("BASE DE DONNEES").Range("A" & derligne).Value = Range("A" & I).Value
Sheets("BASE DE DONNEES").Range("B" & derligne).Value = Range("B" & I).Value
Sheets("BASE DE DONNEES").Range("C" & derligne).Value = Range("C" & I).Value
Sheets("BASE DE DONNEES").Range("D" & derligne).Value = Range("D" & I).Value
Sheets("BASE DE DONNEES").Range("E" & derligne).Value = Range("E" & I).Value
Sheets("BASE DE DONNEES").Range("F" & derligne).Value = Range("F" & I).Value
Sheets("BASE DE DONNEES").Range("G" & derligne).Value = Range("G" & I).Value
Sheets("BASE DE DONNEES").Range("H" & derligne).Value = Range("H" & I).Value
Sheets("BASE DE DONNEES").Range("I" & derligne).Value = Range("I" & I).Value
Sheets("BASE DE DONNEES").Range("J" & derligne).Value = Range("J" & I).Value
Sheets("BASE DE DONNEES").Range("K" & derligne).Value = Range("K" & I).Value
Sheets("BASE DE DONNEES").Range("M" & derligne).Value = Range("L" & I).Value
derligne = derligne + 1
ligneOK = ligneOK & "/" & I

End If
I = I + 1

Loop

Range("B2").End(xlDown).Select
Selection.Borders.LineStyle = xlNone
Application.CutCopyMode = False

If ligneOK <> "" Then
For J = UBound(Split(ligneOK, "/")) To 1 Step -1
Rows("" & Split(ligneOK, "/")(J) & ":" & Split(ligneOK, "/")(J) & "").Delete
Next
End If

End Sub
 

Pièces jointes

  • ESSAIE100.xlsm
    257.1 KB · Affichages: 5

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Robyl,
Pourquoi ne pas effacer les cellules au fil de l'eau avec :
VB:
If Range("L" & I) = "OK" Then
    With Sheets("BASE DE DONNEES")
        .Range("A" & derligne) = Range("A" & I): Range("A" & I) = ""    ' La cellule s'efface
        '...
        .Range("F" & derligne) = Range("F" & I)                         ' La cellule ne s'efface pas
        '...
    End With
    '...
D'autre part, votre Rows(...).Delete supprime la ligne, donc fatalement efface les données en F,G,I ?
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Désolé, je ne l'avais pas vu celle là.
Comme on efface au fil de l'eau la dernière ligne change. Il faut figer la zone de travail au début :
VB:
DerLigne = Range("A65535").End(xlUp).Row + 1
Do While I < DerLigne
De façon que l'index du While reste inchangé, sinon il est recalculé à chaque fois qu'on passe sur le While.
 

RobyL

XLDnaute Nouveau
toujour la même erreur "do sans boucle"
je le place peut etre pas corectement.

Sub Traitement2()

DerLigne = Sheets("BASE DE DONNEES").Range("A65535").End(xlUp).Row + 1
Do While I < DerLigne
ligneOK = ""
I = 1

Do While I < Range("A65535").End(xlUp).Row + 1

If Range("L" & I) = "OK" Then

Sheets("BASE DE DONNEES").Range("A" & DerLigne) = Range("A" & I): Range("A" & I) = ""
Sheets("BASE DE DONNEES").Range("B" & DerLigne) = Range("B" & I): Range("B" & I) = ""
Sheets("BASE DE DONNEES").Range("C" & DerLigne) = Range("C" & I): Range("C" & I) = ""
Sheets("BASE DE DONNEES").Range("D" & DerLigne) = Range("D" & I): Range("D" & I) = ""
Sheets("BASE DE DONNEES").Range("E" & DerLigne) = Range("E" & I): Range("E" & I) = ""
Sheets("BASE DE DONNEES").Range("H" & DerLigne) = Range("H" & I): Range("H" & I) = ""
Sheets("BASE DE DONNEES").Range("J" & DerLigne) = Range("J" & I): Range("J" & I) = ""
Sheets("BASE DE DONNEES").Range("L" & DerLigne) = Range("L" & I): Range("L" & I) = ""
'...
Sheets("BASE DE DONNEES").Range("F" & DerLigne) = Range("F" & I)
Sheets("BASE DE DONNEES").Range("G" & DerLigne) = Range("G" & I)
Sheets("BASE DE DONNEES").Range("I" & DerLigne) = Range("I" & I)

'...
End If
I = I + 1

End Sub
 

Discussions similaires

Réponses
1
Affichages
158
Réponses
18
Affichages
923

Statistiques des forums

Discussions
292 782
Messages
1 926 174
Membres
182 939
dernier inscrit
Mbc31360