déplacement simultané de 2 cellules non contigues

[cycy]

bonjour et merci à vous accordé de l'importance à mon problème
je souhaite sur un tableau déplacer le contenu d'une cellule vers la droite de 1,2,3.. colonnes et qu'en même temps le contenu d'une cellule 4 lignes plus bas ce déplace elle aussi en simultané vers la droite de 1,2,3 ....colonnes
le contenu des cellules est uniquement du texte
je ne veux avoir à sélectionner qu'une seule cellule
cordialement
cyrille

 

[Softmama]

Re : déplacement simultané de 2 cellules non contigues

Re

Ta demande manquait un peu de limpidité, un autre essai en pj, avec ce que j'ai compris.

 

[cycy]

Re : déplacement simultané de 2 cellules non contigues

softmama bonjour ,
ta réponse est de plus en plus proche de ce que j'ai besoin
cependant j'ai fais des notes sur la pj pour que tu vois les probèmes qui subsistent et qui sont pour moi très importants
avant de chercher des solutions , si ce que j'ai noté n'est pas clair , n'hésite pas à me poser des questions
merci
cyrille

 

[Softmama]

Re,

Je vies d'ouvrir ton fichier, et ça y est je crois que j'ai compris ce que tu demandes, je regardes ça plus en détail et te tiens au courant.

 

[Softmama]

Re: Re : déplacement simultané de 2 cellules non contigues

Re,

Tu vas être content je pense. Ton fichier fonctionne et en plus, je pense que j'ai compris ce que tu voulais...

Private MemoVal, BoolDépl As Boolean, MemoSel

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim c As Range
If (Target.Row - 24) Mod 11 < 2 Then
    Set c = Range("B" & Target.Row & ":B" & Target.Row + 11).Find(what:=MemoSel, LookIn:=xlValues, lookat:=xlWhole)
    If Target = "" Then
        If Not c Is Nothing Then
            MemoVal = Target.Offset(c.Row - Target.Row, 0).Value
            Target.Offset(c.Row - Target.Row, 0) = ""
            BoolDépl = True
        End If
    Else
        If Not c Is Nothing Then
            If BoolDépl = True Then
                Target.Offset(c.Row - Target.Row, 0) = MemoVal
                BoolDépl = False
            End If
        End If
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MemoSel = Target.Value
End Sub

cf. fichier joint

 

[cycy]

Re : Re: Re : déplacement simultané de 2 cellules non contigues

re ,
ce que tu viens de faire est absolument génial et correspond à 100 % à mes besoins
je ne sais pas comment te remercier
merci et à + pour d'autres défis
cyrille

 

[cycy]

Re : déplacement simultané de 2 cellules non contigues

bonjour , softmama à travaillé sur ce dossier et à créé qq chose de parfait
j'aimerai y apporter une évolution
merci d'ouvrir le fichier joint pour voir les explications

 

[Softmama]

Re : déplacement simultané de 2 cellules non contigues

Bonjour cycy,

Ceci devrait fonctionner pour ce que tu demandes (à la place des macros en place) :

Private MemoVal, BoolDépl As Boolean, MemoSel

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim c As Range, LignMasquée()
Application.ScreenUpdating = False
ReDim LignMasquée(1 To ActiveSheet.UsedRange.Rows.Count)
For t = 1 To UBound(LignMasquée)
    LignMasquée(t) = IIf(Cells(t, 1).EntireRow.Hidden, True, False)
Next t
Rows.Hidden = False
If (Target.Row - 24) Mod 11 < 2 Then
    Set c = Range("B" & Target.Row & ":B" & Target.Row + 11).Find(what:=MemoSel, LookIn:=xlValues, lookat:=xlWhole)
    If Target = "" Then
        If Not c Is Nothing Then
            MemoVal = Target.Offset(c.Row - Target.Row, 0).Value
            Target.Offset(c.Row - Target.Row, 0) = ""
            BoolDépl = True
        End If
    Else
        If Not c Is Nothing Then
            If BoolDépl = True Then
                Target.Offset(c.Row - Target.Row, 0) = MemoVal
                BoolDépl = False
            End If
        End If
    End If
End If
For t = 1 To UBound(LignMasquée)
    If LignMasquée(t) = True Then Cells(t, 1).EntireRow.Hidden = True
Next t
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MemoSel = Target.Value
End Sub

 

[cycy]

Re : déplacement simultané de 2 cellules non contigues

re ,
je viens de remplacer et adapter la macro dans mon tableau réel
cela fonctionne mais comme j'ai environ 27 clients avec chaque fois 40 lignes par client , quand je déplace une cellule , l'action que tu à rajouté ( afficher les lignes puis masquer les lignes ) deviens très long
y à il une solution plus rapide
merci
cyrille

 

[Softmama]

Re : déplacement simultané de 2 cellules non contigues

Re,

Ha oui, si bcp de lignes, ça risque d'être un peu long, ceci devrait être plus rapide, (à tester) :

Private MemoVal, BoolDépl As Boolean, MemoSel

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim c As Range
If (Target.Row - 24) Mod 11 < 2 Then
    Set c = Cells(Target.Row, 2)
    Do While c.Row < Target.Row + 40 ' Si 40 lignes par client
        If c = MemoSel Then Exit Do
        Set c = c(2, 1)
    Loop
    If Target = "" Then
        If c = MemoSel Then
            MemoVal = Target.Offset(c.Row - Target.Row, 0).Value
            Target.Offset(c.Row - Target.Row, 0) = ""
            BoolDépl = True
        End If
    Else
        If c = MemoSel Then
            If BoolDépl = True Then
                Target.Offset(c.Row - Target.Row, 0) = MemoVal
                BoolDépl = False
            End If
        End If
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MemoSel = Target.Value
End Sub

cf. Fichier en PJ

 

[cycy]

Re : déplacement simultané de 2 cellules non contigues

merci pour ta réponse ,
je n'ai pas le temps de tester ce soir mais je te tiens au courant au plus tôt
cyrille

 

[cycy]

Re : déplacement simultané de 2 cellules non contigues

bonjour softmama , le forum ,
après avoir fait quelques essais ça me semble tout à fait concluant
merci pour ta disponibilité
cyrille