Sub NameTable()
    Set shp = ActiveSheet.Shapes(Application.Caller)
    ad_ = shp.TopLeftCell.Address
    Range(ad_).Select
    For Each obj In ActiveSheet.ListObjects
        If obj.Active Then MsgBox obj.Name: Exit Sub
    Next obj
End Sub

Sub NameTable()
    For Each obj In ActiveSheet.ListObjects
        If obj.Active Then nameTbl = obj.Name: Exit For
    Next obj
    Debug.Print nameTbl
End Sub


Public Sub test()
Debug.Print ActiveCell.ListObject.Name
End Sub





Sub Test_Cell()
    Dim MyTable As ListObject, isect As Range
    For Each MyTable In ActiveSheet.ListObjects
        Set isect = Application.Intersect(ActiveCell, MyTable.Range)
        If Not (isect Is Nothing) Then MsgBox "ActiveCell принадлежит таблице " & MyTable.Name
    Next
End Sub