HELP ! Recopier une valeur en fonction du mois en cours

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rm As Range 'déclare la variable rm (Recherche Mois)
Dim col As Byte 'déclare la variable col (COLonne)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim rd As Range 'déclare la variable rc (Recherche Département)

If Target.Address = "$B$2" Then 'condition 1 : si le changemen a lieu dans B2
    Set rm = Sheets("Tableau").Rows(3).Find(Target.Value, , xlValues, xlWhole) 'définit la recherche du mois rm
    If Not rm Is Nothing Then 'condition 2: si il existe au moins une occurrence du mois dans la ligne 3 de l'onglet 'Tableau"
        col = rm.MergeArea.Column 'définit la colonne col
    Else 'sinon
        MsgBox "L'onglet 'Tableau' ne contient pas le mois : " & Target.Value & " !" 'message
        Exit Sub 'sort de la procédure
    End If 'fin de la condition 2
    For Each cel In Range("A4:A" & Cells(Application.Rows.Count, 1).End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne A
        Set rd = Sheets("Tableau").Columns(1).Find(cel.Value, , xlValues, xlWhole) 'définit la recherche du département rd
        If Not rd Is Nothing Then 'condition 3 : si il existe au moins une occurrence du département dans la colonne 1 de l'onglet 'Tableau"
            cel.Offset(0, 1).Value = Sheets("Tableau").Cells(rd.Row, col).Value 'place dans la colonne B la valeur correspondante
            cel.Offset(0, 2).Value = Sheets("Tableau").Cells(rd.Row, col + 1).Value 'place dans la colonne C la valeur correspondante
        Else 'sinon
            MsgBox "L'onglet 'Tableau' ne contient pas le département " & cel.Value & " !" 'message
        End If 'fin de la condition 3
    Next cel 'prochaine cellule de la boucle
End If 'fin de la condition 1
End Sub