If you are happy to have row 25 initially empty, the following should work.
Public Sub Mark()
Dim CellToUpdate As Range
Set CellToUpdate = Range(Sheet2.Shapes(Application.Caller).TopLeftCell.Address).Offset(0, 1)
CellToUpdate = CellToUpdate + 1
If Cells(25, 1) <> "" Then
Cells(25, Columns.Count).End(xlToLeft).Offset(0, 1) = ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Characters.Text
Else
Cells(25, 1) = ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Characters.Text
End If
End Sub
Bookmarks