Public Sub DefaultMacro() 
    Dim lngCpt As Long 
    Dim strBookmarkName As String 
    Dim strBookmarkValue As String      
    FormatTable "Name", "@@", 1 
    FormatTable "Phone", "@@", 1 
    FormatTable "Country", "@@", 1     
     'Clear unused bookmarks
    RemoveUnusedBookmark     
End Sub 
 
Private Sub RemoveUnusedBookmark() 
    Dim lngCpt As Long 
    Dim strBookmarkName As String 
    Dim strBookmarkValue As String     
    For lngCpt = 1 To ActiveDocument.Bookmarks.Count 
        strBookmarkName = ActiveDocument.Bookmarks(lngCpt).Name 
        Selection.GoTo What:=wdGoToBookmark, Name:=strBookmarkName 
        strBookmarkValue = Selection.Text 
        If strBookmarkName = strBookmarkValue Then SetBookMark strBookmarkName, "" 
    Next lngCpt     
End Sub 
 
Public Sub SetBookMark(ByVal pstrBookmark As String, ByVal pstrValue As String, Optional ByRef pwrdActiveDocument As Document, Optional ByVal pblnKeepBookmark As Boolean = True) 
    Dim wrdRange As Range     
    On Error Goto ActivateError 
    If pwrdActiveDocument Is Nothing Then 
        Set pwrdActiveDocument = ActiveDocument 
    End If 
    If Not pwrdActiveDocument.Bookmarks.Exists(pstrBookmark) Then Exit Sub 
    Set wrdRange = pwrdActiveDocument.Bookmarks(pstrBookmark).Range 
    wrdRange.Text = pstrValue 
    wrdRange.Select 
    If pblnKeepBookmark Then wrdRange.Bookmarks.Add pstrBookmark 
    On Error Goto 0 
ActivateError: 
End Sub 
 
Private Sub FormatTable(ByVal pstrBookmark As String, ByVal pstrSeparator As String, ByVal pintNbrCol As Integer) 
    Dim strTemp As String 
    Dim strTemp2 As String 
    Dim intCpt As Integer 
     
    Selection.GoTo What:=wdGoToBookmark, Name:=pstrBookmark 
    strTemp = Selection.Text 
     
    If InStr(strTemp, pstrSeparator) = 0 Then Exit Sub 
    While InStr(strTemp, pstrSeparator) > 0 
        strTemp2 = Extraire_(strTemp, pstrSeparator) 
        Selection.Text = strTemp2 
        For intCpt = 1 To pintNbrCol 
            Selection.MoveRight Unit:=wdCell 
        Next intCpt 
    Wend 
    If Len(strTemp) > 0 Then Selection.Text = strTemp 
End Sub 
 
Private Function Extraire_(ByRef value As String, Optional ByVal Separator As String = ",") As String 
    If InStr(value, Separator) = 0 Then 
        Extraire_ = value 
        value = "" 
    Else 
        Extraire_ = Mid$(value, 1, InStr(value, Separator) - 1) 
        value = Mid$(value, InStr(value, Separator) + Len(Separator)) 
    End If 
End Function