Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion RobyL
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

RobyL

XLDnaute Junior
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

Trier par date Trier par votes
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:
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
252
CortoXls
C
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
504
GClaire
G
M
  • Question Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
308
MBEPID
M
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
337
Gestionnaire_rh
G
S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
206
spike29
S
C
  • Résolu(e)
XL 2013 Renvoyer 2 dans la cellule
Réponses
2
Affichages
187
candido57
C
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
110
Abi23
A
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
363
Oneida
S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
556
Dranreb
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
482
Chaton77
B
  • Question Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
609
Compte Supprimé 979
C
D
  • Question Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
2 K
Dranreb
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
200
sebastien176
S
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
82
piga25
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
221
patricktoulon
M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
465
Minus&Cortex
M
D
  • Question Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
1 K
AtTheOne
E
  • Résolu(e)
XL 2019 transfer listbox vers une colonne à partir de la 4 ligne
Réponses
2
Affichages
180
escudo
E
R
  • Question Question
XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur
Réponses
1
Affichages
474
Aya_flo
A
L
  • Question Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
376
AtTheOne
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…