Modification "option explicit"

[JJ1]

Bonjour,

J'ai voulu modifier un code dans la Feuil1 (code présent) qui jumellerait 2 plages T:X en une seule en T:AC en cliquant sur 2 cellules en colonne S.
Je joins un exemple pour mieux comprendre.

merci pour votre modification.

Bonne soirée

 

[Fred0o]

Re : Modification "option explicit"

Bonsoir JJ1,

Voici un code qui semble répondre à ton besoin (si j'ai bien tout compris). Pour ce code, il te faut créer 2 champs nommés. Le premier "NbClick" = 0, et le deuxième "Lig1" = 1. Ces champs sont mis à jour dans la macro.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim c As Range
    If Target.Address = "$AD$1" Then
        Range("Y2:AC100").Value = ""
        ActiveWorkbook.Names("NbClick").RefersTo = "=0"
        Exit Sub
    End If
    If Intersect(ActiveCell, Range("S2:S100")) Is Nothing Then Exit Sub
    ActiveWorkbook.Names("NbClick").RefersTo = [NbClick] + 1
    If [NbClick] = 1 Then
        ActiveWorkbook.Names("Lig1").RefersTo = Target.Row
    ElseIf [NbClick] = 2 Then
        For Each c In Range(Cells(Target.Row, 20), Cells(Target.Row, 24))
            Cells([Lig1], c.Column + 5) = Cells(Target.Row, c.Column)
        Next
    End If
End Sub

A+

 

[Efgé]

Re : Modification "option explicit"

Bonjour JJ1, Bonjour Fred0o
Une autre approche, sous réserve d'avoir compris:

Option Explicit
Public NbrClics As Integer
Public L As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$AD$1" Then
    Range("Y2:AC100").Value = ""
    NbrClics = 0
    Exit Sub
End If
If Not Intersect(Target, Range("S2:S100")) Is Nothing Then
    NbrClics = NbrClics + 1
    If NbrClics = 1 Then L = Target.Row
    If NbrClics = 2 Then
        Range(Target(1, 2), Target(1, 6)).Copy Cells(L, 25)
        NbrClics = 0
    End If
Else
    NbrClics = 0
End If
End Sub

Cordialement

 

[job75]

Re : Modification "option explicit"

Bonjour JJ, Fred0o,

J'y vais de ma solution :

Dim r As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, [S:S]) Is Nothing Then
  If r Is Nothing Then
    Set r = ActiveCell
  Else
    ActiveCell(1, 2).Resize(, 5).Copy r(1, 7)
    Set r = Nothing
  End If
ElseIf ActiveCell.Address = "$AD$1" Then
  [Y:AC].Clear
End If
End Sub

Fichier joint.

A+

 

[job75]

Re : Modification "option explicit"

Re,

Fichier (2) avec une variable Static.

A+

 

[JJ1]

Re : Modification "option explicit"

Bonsoir à tous,

Un grand merci, j'ai testé vos 3 solutions: nickel comme d'hab !

Bonne soirée et encore merci.