XL 2016 Renseigner une plage 2 a partir d'une plage 1 selon le mois.

[KTM]

Bonsoir chers tous
je voudrais renseigner une plage 2 a partir d'une plage 1 selon le mois choisi.
Jai fais une macro mais elle ne fonctionne pas comme je souhaite.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2" Then
    Dim Rg As Range, R As Range
    Dim plg1 As Range, plg2 As Range
    Dim mydate As Date
    mydate = CDate([C2])
    
    Set Rg = Sheets("Base 1").Range("C3:N3").Find(CDate(mydate))
    Set R = Sheets("Base 2").Range("E4:P4").Find(CDate(mydate))
          Set plg1 = Range(Rg.Address).Offset(1).Resize(4)
          Set plg2 = Range(R.Address).Offset(1).Resize(4)
          plg2 = plg1
End If
End Sub

 

[sylvanu]

Bonsoir KTM,
Une autre approche avec :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2" Then
    Dim C1%, C2%    ' C1 colonne Base1, C2 colonne Base2
    With Sheets("Base 1")
        C1 = Application.Match(Target, .[3:3], 0)
        C2 = Application.Match(Target, [4:4], 0)
        Range(Cells(5, C2), Cells(8, C2)) = .Range(.Cells(4, C1), .Cells(7, C1)).Value
    End With
End If
End Sub

 

[KTM]

Bonsoir KTM,
Une autre approche avec :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2" Then
    Dim C1%, C2%    ' C1 colonne Base1, C2 colonne Base2
    With Sheets("Base 1")
        C1 = Application.Match(Target, .[3:3], 0)
        C2 = Application.Match(Target, [4:4], 0)
        Range(Cells(5, C2), Cells(8, C2)) = .Range(.Cells(4, C1), .Cells(7, C1)).Value
    End With
End If
End Sub

Merci beaucoup . Ca marche
Mais une doléance:
Je voudrais une autre solution au cas ou on devait faire le chargement par un bouton auquel associer la macro.
J'espère ne pas demander plusieurs choses à la fois...
Encore Merci..

 

[sylvanu]

Bonjour KTM,
Dans le même genre avec un bouton :

Option Explicit
Sub AppuiBouton()
Dim F1, F2, C1, C2 ' C1 colonne Base1, C2 colonne Base2
Set F1 = Sheets("Base 1"): Set F2 = Sheets("Base 2")
C1 = Application.Match(F2.[C2], F1.[A3:O3], 0)
C2 = Application.Match(F2.[C2], F2.[A4:O4], 0)
F2.Range(F2.Cells(5, C2), F2.Cells(8, C2)) = F1.Range(F1.Cells(4, C1), F1.Cells(7, C1)).Value
End Sub

 

[KTM]

Bonjour KTM,
Dans le même genre avec un bouton :

Option Explicit
Sub AppuiBouton()
Dim F1, F2, C1, C2 ' C1 colonne Base1, C2 colonne Base2
Set F1 = Sheets("Base 1"): Set F2 = Sheets("Base 2")
C1 = Application.Match(F2.[C2], F1.[A3:O3], 0)
C2 = Application.Match(F2.[C2], F2.[A4:O4], 0)
F2.Range(F2.Cells(5, C2), F2.Cells(8, C2)) = F1.Range(F1.Cells(4, C1), F1.Cells(7, C1)).Value
End Sub

MERCI...