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

[RobyL]

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

 

[sylvanu]

Bonjour Robyl,
Pourquoi ne pas effacer les cellules au fil de l'eau avec :

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 ?

 

[RobyL]

bonjour,
merci sylvanu

cela m'affiche une erreur de compilation : "do sans boucle"

 

[sylvanu]

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 :

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]

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