Comment lire une date dans un calendrier ?

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect

Dim Ligne
Dim Colonne
Dim A As Variant


If Not Intersect(Target, Range("D5:D36")) Is Nothing Then


 
   'Je lance l'userform

      UserForm1.Show
 'Si la première colonne de mon tableau de g6 à g36 est vide j'impute la date du DTPicker21 qui est sur la feuille "Programme des travaux" au DTPicker1 sur L'UserForm1
    
      If Application.WorksheetFunction.Sum(Range("G6:G36")) = 0 Then
      UserForm1.DTPicker1.Value = Me.DTPicker21.Value
       UserForm1.Durée.Value = Range("D36").End(xlUp).Offset(0, 1).Value
       ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
      Exit Sub
      End If
      
       Ligne = 5
       
      If Application.WorksheetFunction.Sum(Range("G6:G36")) <> 0 Then

'Durée = combobox sur l'userform1 et jusque là ça fonctionne très bien
      UserForm1.Durée.Value = Range("D36").End(xlUp).Offset(0, 1).Value

Je fais de la gymnastique avec les offset de façon à me positionner sur ma dernière entrée dans le tableau, puis remonter sur la ligne afin d'y lire la date
 
     Range("D36").End(xlUp).Offset(-1, 106).Select

'Je trouve bien le N° de colonne
      Colonne = ActiveCell.End(xlToLeft).Column

'mais à partir d'ici plus rien ne fonctionne, pas moyen de sélectionner la cellule correspondante
       ActiveCell(Ligne, Colonne).Offset(1, 0).Select

'Pas moyen de récupérer la date
      A = ActiveCell(Ligne, Colonne).Value

   'donc cette condition ne s'exécute jamais   
       If A <> 0 Then
      UserForm1.DTPicker1.Value = ActiveCell(Ligne, Colonne).Value
      ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
      Exit Sub
      End If
  'Et celle-ci toujour puisque je n'ai pas de date dans A, mais bien sur il y a erreur puisque ça lie soit la deuxième cellule de la fusion ou il y a rien soit comme en haut je n'arrive pas à lire la date     
      If A = 0 Then
      UserForm1.DTPicker1.Value = ActiveCell(Ligne, Colonne +1).Value
       End If

   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   End If
   Exit Sub
ETIQUETTE: MsgBox "Changer la date manuellement & vbokonly"
  
      
End Sub