Modification "option explicit"

J

JJ1

Guest
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
 

Pièces jointes

  • copie.xls
    39.5 KB · Affichages: 33
  • copie.xls
    39.5 KB · Affichages: 36
  • copie.xls
    39.5 KB · Affichages: 48

Fred0o

XLDnaute Barbatruc
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.
VB:
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+
 

Pièces jointes

  • JJ1_V1.xls
    43.5 KB · Affichages: 25
  • JJ1_V1.xls
    43.5 KB · Affichages: 27
  • JJ1_V1.xls
    43.5 KB · Affichages: 27

Efgé

XLDnaute Barbatruc
Re : Modification "option explicit"

Bonjour JJ1, Bonjour Fred0o
Une autre approche, sous réserve d'avoir compris:
VB:
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
 

Pièces jointes

  • JJ1_V2.xls
    37.5 KB · Affichages: 25

job75

XLDnaute Barbatruc
Re : Modification "option explicit"

Bonjour JJ, Fred0o,

J'y vais de ma solution :

Code:
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+
 

Pièces jointes

  • copie(1).xls
    44 KB · Affichages: 23
  • copie(1).xls
    44 KB · Affichages: 26
  • copie(1).xls
    44 KB · Affichages: 29

Discussions similaires

Réponses
46
Affichages
1 K
Réponses
29
Affichages
1 K