deplacer cellule suivant 2 conditions vba

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

  • comp2.xlsm
    27.4 KB · Affichages: 72

obyone

XLDnaute Occasionnel
Bonsoir jbarbe,
Merci pour ta reponse oui il y aura toujours quelque chose dans ma colonne nom sauf quand il y aura aucune mise a jour
J'ai essaye la macro sur office 13 ca plante, j'essayerais demain sur 2007.
Je pense modifier un peu.... Car il n'y aura de deplacement que si la colonne 1 est cochée et ensuite deplacer en fonction de la colonne 2.
Qu'en penses tu?
Pour info le tableau maj est rempli automatiquement s'il y a une difference entre plusieurs bases de donnees et les fichiers contenus sur un serveur, donc si aucunes differences le tableau reste vide...

Voila
Bonne soiree et merci de ton aide
Je travaille decu demain je te tiens au courant
Merci encore
 

JBARBE

XLDnaute Barbatruc
Bonsoir jbarbe,
Je pense modifier un peu.... Car il n'y aura de deplacement que si la colonne 1 est cochée et ensuite deplacer en fonction de la colonne 2.
Merci encore
Re,
J'ai modifié ceci en tenant compte de ta suggestion !
ElseIf .Cells(I, 1) = "" And .Cells(I, 2) = "" And .Cells(I, 3) <> "" Then
par
ElseIf .Cells(I, 1) = "" And .Cells(I, 3) <> "" Then
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, 3) <> "" Then
Else
I = 1
End If
Next I
End With
Application.ScreenUpdating = True
End Sub

Chez moi avec excel 2007 ça marche !
Mais il se peut qu'avec l'outil création de tableau, la macro fonctionne mal parfois !!!!
bonne nuit !
 

Discussions similaires

Réponses
8
Affichages
284

Statistiques des forums

Discussions
312 231
Messages
2 086 433
Membres
103 207
dernier inscrit
Michel67