Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "A1" Then CollectSheetData ActiveSheet, Target.Value
End Sub

Private Sub CollectSheetData(shTarget As Worksheet, sFind As String)
    Dim dt As Date
    If IsDate(sFind) Then
        dt = CDate(sFind)
    Else
        Stop
    End If
    
    Dim resultArr As Variant
    Dim resultFrr As Variant
    ReDim resultArr(0 To 0)
    resultFrr = resultArr
    
    Dim shSource As Worksheet
    For Each shSource In shTarget.Parent.Worksheets
        If shSource.Name <> shTarget.Name Then CollectOneSheet shSource, shTarget, dt, resultArr, resultFrr
    Next
    If UBound(resultArr) > 0 Then
        Dim yy As Long
        Dim arr As Variant
        ReDim arr(1 To UBound(resultArr), 1 To 1)
        For yy = 1 To UBound(arr, 1)
            arr(yy, 1) = resultFrr(yy)
        Next
        shTarget.Range("A2").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    Else
        shTarget.Range("A2").Resize(shTarget.UsedRange.Rows.Count).ClearContents
    End If
End Sub

Private Sub CollectOneSheet(shSource As Worksheet, shTarget As Worksheet, dtFind As Date, resultArr As Variant, resultFrr As Variant)
    Dim yy As Long
    yy = shSource.UsedRange.Rows.Count
    
    Dim arr As Variant
    Dim drr As Variant
    If yy = 1 Then
        ReDim arr(1 To 1, 1 To 1)
        drr = arr
        arr(1, 1) = shSource.UsedRange.Range("A1").Value
        drr(1, 1) = shSource.UsedRange.Range("H1").Value
    Else
        arr = shSource.UsedRange.Range("A1").Resize(yy, 1).Value
        drr = shSource.UsedRange.Range("H1").Resize(yy, 1).Value
    End If
    
    For yy = 1 To UBound(arr, 1)
        If Not IsError(drr(yy, 1)) Then
            If IsDate(drr(yy, 1)) Then
                If Year(drr(yy, 1)) = Year(dtFind) Then
                    If Month(drr(yy, 1)) = Month(dtFind) Then
                        ReDim Preserve resultArr(LBound(resultArr) To UBound(resultArr) + 1)
                        ReDim Preserve resultFrr(LBound(resultArr) To UBound(resultFrr) + 1)
                        resultArr(UBound(resultArr)) = arr(yy, 1)
                        resultFrr(UBound(resultArr)) = "='" & shSource.Name & "'!R" & shSource.UsedRange.Row + yy - 1 & "C" & shSource.UsedRange.Column
                    End If
                End If
            End If
        End If
    Next
End Sub