Option Explicit

Sub Макрос1()
    [A27] = [A27] + 1
End Sub

Sub Макрос2()
    [A29] = [A29] + 1
End Sub

Sub ФигураI27_Щелчок()
    runShapeMacro Application.Caller
End Sub

Sub ФигураK34_Щелчок()
    runShapeMacro Application.Caller
End Sub

Sub runShapeMacro(ByVal shapeName As String)

    Dim rng         As Range
    Dim rngCurr     As Range
    Dim rngDest     As Range
    Dim wksName     As String
    Dim cellAddr    As String
    Dim addr        As String
    Dim rowLast     As Long
    Dim row         As Long
    
    addr = Replace(shapeName, "Фигура", "")
    Set rng = ActiveSheet.Range(addr)

    Set rngCurr = rng.CurrentRegion
    rowLast = rngCurr.row + rngCurr.Rows.Count - 1 - rng.row
    
    'добавить в  определенные ячейки, определенных листов -
    'числа которые стоят по левую сторону от названия ячеек,
    For row = 1 To rowLast
        wksName = rng.Offset(row, 1)
        If wksName <> "" Then
            cellAddr = rng.Offset(row, 0)
            Set rngDest = Worksheets(wksName).Range(cellAddr)
            rngDest.Value = rng.Offset(row, -1)
        End If
    Next row
    
    'Удалить число идущее по левую сторону от ячейки,
    rng.Previous.MergeArea.Cells(1) = ""
    
    'И запустить макрос, записанный по правую сторону от ячейки.
    Application.Run CStr(rng.Offset(0, 1))
End Sub