Need to get shape data from Visio object to my custom object

Sub Copy_Shape_Data4()
' If named row already exists in TO shape, overwrites its cell values,
' otherwise creates a new row
'
' Does not affect shape data rows in TO shape if row names don't match
' those in the FROM shape
 
    Dim shpFrom As Visio.Shape, shpTo As Visio.Shape
    Dim rowFrom As Visio.Row, rowTo As Visio.Row
    
    Dim ixFromRow As Integer, ixToRow As Integer
    Dim ixCol As Integer
        
    Dim Msg1 As String, Msg2 As String, Msg3 As String, Msg4 As String
    Dim Msg5 As String, Msg6 As String
            
    Msg1 = "Please select two shapes before running this macro" & vbCrLf & vbCrLf
    Msg2 = "1) Select the shape FROM which the properties will be copied" & vbCrLf
    Msg3 = "2) SHIFT+Select the shape TO which the properties will be copied" & vbCrLf
    Msg4 = "3) Run this macro again"
            
    
    ' Check that exactly two shapes are selected; if not prompt then exit
    If ActiveWindow.Selection.Count <> 2 Then
        MsgBox Msg1 & Msg2 & Msg3 & Msg4, vbOKOnly, "Copy Shape Data"
        Exit Sub
    End If
    
    ' FROM shape is the one that was selected first
    Set shpFrom = ActiveWindow.Selection(1)
    ' TO shape is the one that was selected second
    Set shpTo = ActiveWindow.Selection(2)
    
    ' Confirm the FROM and TO shape selections
    Msg5 = "Copy shape data FROM " & Chr(34) & shpFrom.Name & Chr(34)
    Msg6 = " TO " & Chr(34) & shpTo.Name & Chr(34) & "?"
    msgbutton = MsgBox(Msg5 & Msg6, vbYesNo, "Copy Shape Data")
   
    If msgbutton = vbNo Then
       MsgBox Msg2 & Msg3 & Msg4, vbOKOnly, "Copy Shape Data"
       Exit Sub
    End If
      
    ' Create shape data section if it doesn't already exist
    If Not shpTo.SectionExists(visSectionProp, False) Then
        shpTo.AddSection (visSectionProp)
    End If
    
    For ixFromRow = 0 To shpFrom.RowCount(visSectionProp) - 1
        Set rowFrom = shpFrom.Section(visSectionProp).Row(ixFromRow)
        
        If shpTo.CellExists("Prop." & rowFrom.Name, False) Then
            ' Named row already exists so get its row number
            ixToRow = shpTo.CellsRowIndex("Prop." & rowFrom.Name)
        Else
            ' Row doesn't exists so create it and get its row number
            ixToRow = shpTo.AddNamedRow(visSectionProp, rowFrom.Name, visTagDefault)
        End If
                
        For ixCol = 0 To shpFrom.RowsCellCount(visSectionProp, ixRow) - 1
            shpTo.CellsSRC(visSectionProp, ixToRow, ixCol).FormulaForceU = _
            shpFrom.CellsSRC(visSectionProp, ixFromRow, ixCol).FormulaU
        Next ixCol
    Next ixFromRow
 
End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66: