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

deplacer cellule suivant 2 conditions vba

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion obyone
  • 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
O

obyone

XLDnaute Occasionnel
bonjour,

je souhaite deplacer une cellule suivant 2 conditions.
dans ma feuille MAJ
si il y a un x dans la colonne MAJ alors on deplace la valeur de la colonne 3 dans la feuille de la colonne 2 puis on supprime la ligne

la cellule déplacer devra se trouver dans la seconde colonne du nouveau tableau.

j'ai essayé mais j'ai un bug

merci d'avance
 

Pièces jointes

Trier par date Trier par votes
bonsoir Jbarbe,
ca bug plus mais il m'affiche la donnée dans la première colonne du tableau essai, je ne trouve pas comment la décaler peux tu m'expliquer à quoi correspond le Sub()essai que tu as ajouté?

cordialement
 
Vote positif 0 Vote négatif
bonjour,

j'ai de nouveau un probleme lors que j'ai plusieurs lignes à copier il me copie seulement 1 ligne sur 2, pourquoi?

Sub Essai()
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
With Sheets("MAJ")
For i = 2 To 65000
If .Cells(i, 1).Value = "" Then Exit Sub
If .Cells(i, 1).Value = "x" And .Cells(i, 2).Value = "essai" Then .Cells(i, 3).Copy
Sheets("essai").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(i, 1).EntireRow.Delete
Next i
End With
Application.ScreenUpdating = True
End Sub


merci d'avance
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour à tous,
En effet pas suffisamment testé !
Nécessaire Fait en ajoutant i = 1 ( permettant de revenir à la ligne 1 + 1 afin de corriger le problème dû à la suppression d'une ligne )

Code: 
Sub Essai()
Dim i As Long
Application.ScreenUpdating = False
With Sheets("MAJ")
For i = 2 To 65000
If .Cells(i, 1).Value = "" Then Exit Sub
If .Cells(i, 1).Value = "x" And .Cells(i, 2).Value = "essai" Then .Cells(i, 3).Copy
Sheets("essai").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(i, 1).EntireRow.Delete
i = 1
Next i
End With
Application.ScreenUpdating = True
End Sub


bonne journée !
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
boujour,

j'ai une modif de la formule, la colonne 2 change, elle indique le non de la feuille ou "transférer" la ligne...

j'ai essayé ce code la mais ca plante...

Code: 
Sub Bouton1_Clic()
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
With Sheets("MAJ")

Range("MAJ").Sort Key1:=Range("A1"), Order1:=xlAscending
If .Cells(I, 1).Value = "" Then Exit Sub

For I = .Cells(2, 1).End(xlDown).Row To 4 Step -1
        If .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai" Then
        ligne_vide = Sheets("essai").Cells(Rows.Count, 1).End(xlUp).Row
            If Not Sheets("essai").Cells(ligne_vide, 1) = "" Then ligne_vide = ligne_vide + 1
            For J = 1 To 8
            Sheets("essai").Cells(ligne_vide, J).Value = Sheets("MAJ").Cells(I, J).Value
            Next J
            Sheets("MAJ").Cells(I, 1).EntireRow.Delete
           
        End If
      Next I
      I = 1
     
For I = .Cells(2, 1).End(xlDown).Row To 4 Step -1
        If .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "Feuil1" Then
        ligne_vide = Sheets("essai").Cells(Rows.Count, 1).End(xlUp).Row
            If Not Sheets("essai").Cells(ligne_vide, 1) = "" Then ligne_vide = ligne_vide + 1
            For J = 1 To 8
            Sheets("essai").Cells(ligne_vide, J).Value = Sheets("MAJ").Cells(I, J).Value
            Next J
            Sheets("MAJ").Cells(I, 1).EntireRow.Delete
           
        End If
      Next I
      I = 1

End With
   
End Sub


merci d'avance de votre aide
 

Pièces jointes

Vote positif 0 Vote négatif
re bonjour,

j'ai fais le code suivant qui fonctionne mais je suis obligé de cliquer 2 fois sur le bouton....


Sub Bouton1_Clic()
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
With Sheets("MAJ")

Range("MAJ").Sort Key1:=Range("A1"), Order1:=xlAscending

If .Cells(2, 1).Value = "" Then Exit Sub

For I = 2 To 30000
If .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai" Then
ligne_vide = Sheets("essai").Cells(Rows.Count, 1).End(xlUp).Row
If Not Sheets("essai").Cells(ligne_vide, 1) = "" Then ligne_vide = ligne_vide + 1
For J = 1 To 4
Sheets("essai").Cells(ligne_vide, J).Value = Sheets("MAJ").Cells(I, J).Value
Next J
Sheets("MAJ").Cells(I, 1).EntireRow.Delete

ElseIf .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai2" Then
ligne_vide = Sheets("essai2").Cells(Rows.Count, 1).End(xlUp).Row
If Not Sheets("essai2").Cells(ligne_vide, 1) = "" Then ligne_vide = ligne_vide + 1
For J = 1 To 4
Sheets("essai2").Cells(ligne_vide, J).Value = Sheets("MAJ").Cells(I, J).Value
Next J
Sheets("MAJ").Cells(I, 1).EntireRow.Delete

End If
Next I
I = 1


End With

End Sub

y a t il une solution?
merci d'avance
 
Vote positif 0 Vote négatif
bonjour,

j'ai modifié mon code comme ceci

Sub Bouton1_Clic()
Dim I As Long
Dim J As Long


With Sheets("MAJ")



For I = 2 To .Range("A1").CurrentRegion.Rows.Count
If .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai" Then
ligne_vide = Sheets("essai").Cells(Rows.Count, 1).End(xlUp).Row
If Not Sheets("essai").Cells(ligne_vide, 1) = "" Then ligne_vide = ligne_vide + 1
For J = 1 To 3
Sheets("essai").Cells(ligne_vide, 2).Value = Sheets("MAJ").Cells(I, J).Value
Next J
Sheets("MAJ").Cells(I, 1).EntireRow.Delete

ElseIf .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai2" Then
ligne_vide = Sheets("essai2").Cells(Rows.Count, 1).End(xlUp).Row
If Not Sheets("essai2").Cells(ligne_vide, 1) = "" Then ligne_vide = ligne_vide + 1
For J = 1 To 3
Sheets("essai2").Cells(ligne_vide, 2).Value = Sheets("MAJ").Cells(I, J).Value
Next J
Sheets("MAJ").Cells(I, 1).EntireRow.Delete

ElseIf .Cells(I, 1).Value = "" Then Exit Sub


End If

I = 1
Next I


End With

End Sub

mais le probleme c'est qu'il me copie que la derniere valeur, j'aimerais qu' apres le clic sur le bouton les valeurs 1 et 2 apparaissent sur leur tableau respectif.

merci d'avance
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour à tous,
Comme tu sais programmé, pourquoi n'adapte tu pas ma macro ( du post 7) suivante qui fonctionne ( elle ne te conviens pas ) à ta nouvelle demande !

Code: 
Sub Essai()
Dim i As Long
Application.ScreenUpdating = False
With Sheets("MAJ")
For i = 2 To 65000
If .Cells(i, 1).Value = "" Then Exit Sub
If .Cells(i, 1).Value = "x" And .Cells(i, 2).Value = "essai" Then .Cells(i, 3).Copy
Sheets("essai").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(i, 1).EntireRow.Delete
i = 1
Next i
End With
Application.ScreenUpdating = True
End Sub

bonne journée !
 
Dernière édition:
Vote positif 0 Vote négatif
re bonjour,
j'ai de nouveau un probleme, cela plante sur cette ligne

ActiveSheet.Paste

si il n'y a pas "essai" ou "essai2" dans la colonne 2

voici mon code

Sub Bouton1_Clic()
Dim I As Long
Dim J As Long

Application.ScreenUpdating = False
With Sheets("MAJ")
For I = 2 To 65000
If .Cells(I, 1).Value = "" Then Exit Sub
If .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai" Then .Cells(I, 3).Copy
Sheets("essai").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(I, 1).EntireRow.Delete
If .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai2" Then .Cells(I, 3).Copy
Sheets("essai2").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(I, 1).EntireRow.Delete
I = 1
Next I
End With
Application.ScreenUpdating = True



End Sub


merci d'avance...
 
Vote positif 0 Vote négatif
Re,
A tester :
Code: 
Sub Test()
Dim I As Long
Application.ScreenUpdating = False
With Sheets("MAJ")
For I = 2 To 65000
'If .Cells(I, 1).Value = "" Then Exit Sub
If .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai" Then
.Cells(I, 3).Copy
Sheets("essai").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(I, 1).EntireRow.Delete
I = 1
ElseIf .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai2" Then
.Cells(I, 3).Copy
Sheets("essai2").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(I, 1).EntireRow.Delete
I = 1
ElseIf .Cells(2, 1) = "" And .Cells(2, 2) = "" And .Cells(3, 1) = "" _
And .Cells(3, 2) = "" And .Cells(3, 3) = "" Then
Exit Sub
ElseIf .Cells(2, 1) <> "" And .Cells(2, 2) = "" And .Cells(2, 3) <> "" Then
Else
I = 1
End If
Next I
End With
Application.ScreenUpdating = True
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re,
seconde proposition si la colonne C (nom) de la feuille MAJ soit toujours renseignée :
Code: 
Sub TestA()
Dim I As Long
Application.ScreenUpdating = False
With Sheets("MAJ")
For I = 2 To 65000
If .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai" Then
.Cells(I, 3).Copy
Sheets("essai").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(I, 1).EntireRow.Delete
I = 1
ElseIf .Cells(I, 1).Value = "x" And .Cells(I, 2).Value = "essai2" Then
.Cells(I, 3).Copy
Sheets("essai2").Select
If Range("B2") = "" Then ' si la cellule B2 est vide alors
Range("B2").Select ' cellule B2 selectionnée
Else ' sinon
Range("B1").End(xlDown).Offset(1, 0).Select 'une cellule vide plus bas que la selection selectionnée
End If
ActiveSheet.Paste ' cellule B2 copiée
Application.CutCopyMode = False
Sheets("MAJ").Cells(I, 1).EntireRow.Delete
I = 1
ElseIf .Cells(I, 1) = "" And .Cells(I, 2) = "" And .Cells(I, 3) = "" Then
Exit Sub
ElseIf .Cells(I, 1) = "" And .Cells(I, 2) = "" And .Cells(I, 3) <> "" Then
Else
I = 1
End If
Next I
End With
Application.ScreenUpdating = True
End Sub
 
Dernière édition:
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

P
  • Résolu(e)
Microsoft 365 Remplissage tableau avec 2 conditions
Réponses
4
Affichages
208
pierrof
P
G
  • Question Question
Microsoft 365 Formule avec conditions
Réponses
3
Affichages
258
Gerantoine
G
B
  • Résolu(e)
Microsoft 365 Recherche de plusieurs critères dans une cellule
2
Réponses
19
Affichages
574
Bambi35
B
S
  • Question Question
Microsoft 365 VBA Action suivant le résultat d'une cellule
Réponses
7
Affichages
242
TooFatBoy
  • Résolu(e)
XL 2021 Problème à l'utilisation calendrier de Patricktoulon.
Réponses
6
Affichages
635
SAMUAL_2023
S
W
  • Question Question
XL 2013 Reporter valeur suivant date la plus ancienne
2
Réponses
15
Affichages
716
walki
W
  • Résolu(e)
Microsoft 365 Découper un fichier en plusieurs fichiers
2
Réponses
24
Affichages
551
nat54
T
  • Question Question
Microsoft 365 Identifier si une cellule contient une valeur parmi une liste de valeur
Réponses
5
Affichages
300
TRANSPLANT69
T
F
  • Question Question
Microsoft 365 Code article suivant
Réponses
8
Affichages
329
OKBI
O
J
  • Résolu(e)
Microsoft 365 Première cellule vide ou égal zéros dans une plage définie
Réponses
11
Affichages
304
juju91
J
O
  • Question Question
Microsoft 365 Copie sous conditions sans VBA
Réponses
1
Affichages
226
obyone
O
P
  • Question Question
XL pour MAC MAC OS - question sur macro VBA pour gestion fichier budget
Réponses
0
Affichages
167
pamino
P
A
  • Question Question
Déplacer données en vba
Réponses
3
Affichages
505
akm
A
Y
  • Question Question
XL 2019 Masquer automatiquement des lignes selon la valeur d'une cellule ?
Réponses
2
Affichages
409
Yogean
Y
R
  • Résolu(e)
XL 2021 NB.SI dans la colonne n°3
Réponses
4
Affichages
187
rpatty85
R
  • Question Question
Microsoft 365 supprimer des cellules sans abimer les mfc
Réponses
3
Affichages
371
bsalv
B
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
627
un internaute
U
D
  • Question Question
XL 2019 Boucle For Next and select case
Réponses
2
Affichages
207
dadaze
D
M
  • Résolu(e)
XL 2021 Problème d'activation d'une macro pour transférer des valeurs d'une feuille 1 à une feuille 2
Réponses
3
Affichages
300
MATLEA
M
C
  • Résolu(e)
Autres Validation de données avant verrouillage de la ligne
2
Réponses
17
Affichages
575
com689
C
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…