Option Explicit

Private ws_Cald As Worksheet, ws_Data As Worksheet
Private rng_Data As Range, rng As Range, eL As Range

Public Sub Раскидать_Данные_по_Календарю()

    With ActiveWorkbook
        Set ws_Cald = .Worksheets("КАЛЕНДАРЬ")
        Set ws_Data = .Worksheets("ДАННЫЕ")
    End With

    Set rng_Data = ws_Data.[a1].CurrentRegion

    For Each eL In rng_Data
        If IsDate(eL.Value) Then Cald_Sow
    Next
    MsgBox "Всё"
End Sub

Private Sub Cald_Sow()
    Dim iRow As Long, iCol As Long

    With ws_Cald
        ' найти столбец
        Set rng = .Cells.Find(what:=eL.Value, _
                    LookIn:=xlValues)

        If rng Is Nothing Then Exit Sub    ' =>

        iCol = rng.Column

        ' найти строку
        iRow = _
        .Cells.Columns(iCol).Find(what:="*", _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        'Вставить событие
        .Cells(iRow + 1, iCol).Value = _
        "№ " & ws_Data.Cells(eL.Row, 1).Value & _
        " " & _
        ws_Data.Cells(1, eL.Column).Value

    End With
End Sub