Wenn man nur Nomen ausgeben möchte, dann muss man eine leichte Änderung am Code vornehmen, da in meinem letzten Codeschnipsel For-Each zum Einsatz kommt, wir aber auf eine Zählschleife zugreifen müssen (wir brauchen den Index von vntMeaning für die POS, diesen haben aber wegen der For-Each-Schleife nicht) - siehe unten.

Es gäbe noch eine andere Möglichkeit das zu lösen, ich würde es aber hierbei belassen wollen. ;) Mir liegt hier gerade mehr daran, dass du erkennst, dass mitunter der verwendete Schleifen-Typ wichtig/relevant sein kann.

Option Explicit
 
Sub Test()
   
  'Verweis auf Word hinzufügen
  ' * VBA-Editor Menü 'Extras' -> 'Verweise...' -> Microsoft Word X.0 Object Library
   
  Dim objWord     As Word.Application
  Dim objSynInfo  As Word.SynonymInfo
  Dim rngCell     As Excel.Range
  Dim vntMeaning  As Variant
  Dim vntSyn      As Variant
  Dim bolFlag     As Boolean
  Dim lngOffset   As Long
  Dim i           As Long
   
  'neue Word-Instanz erstellen
  Set objWord = New Word.Application
   
  'jede Zelle in der aktuellen Auswahl einzeln behandeln
  For Each rngCell In Selection.Cells
     
    'Thesarus/Synonyme für das Wort in der Zelle suchen
    Set objSynInfo = objWord.SynonymInfo(rngCell.Text, wdGerman)
     
    'für das aktuelle Wort kann es mehrere Bedeutungen geben
    '(z.B. für 'Gut' als Substantiv -> 'Anwesen', Bauernhof, ...; oder als Adjektiv -> die gut[en] Sitten)
    lngOffset = 1
    
'    For Each vntMeaning In objSynInfo.MeaningList
    For i = 1 To objSynInfo.MeaningCount
      
      vntMeaning = objSynInfo.MeaningList(i)

      'Was haben wir für eine Bedeutungen vorliegen? - Nomen, Adverb, Verb, ...
      Select Case objSynInfo.PartOfSpeechList(i)
        Case WdPartOfSpeech.wdNoun ', WdPartOfSpeech.wdAdverb, ...
          bolFlag = True 'Flag/Schalter: EIN
        Case Else
          bolFlag = False 'Flag/Schalter: AUS
      End Select
      
      'Synonyme nur hinzufügen wenn Bedeutungs-Flag/-Schalter auf EIN steht
      If bolFlag = True Then
        'hier werden nun Synonyme unter der jeweiligen Bedeutung gesucht
        '(z.B. 'Gut' mit der Bedeutung von z.B. 'Anwesen')
        For Each vntSyn In objSynInfo.SynonymList(vntMeaning)
          'spaltenweise - in der selben Zeile -  ausgeben
          rngCell.Offset(, lngOffset).Value = vntSyn
          lngOffset = lngOffset + 1
        Next
      End If
      
    Next
     
  Next
   
  'Word-Instanz schließen
  objWord.Quit False
   
End Sub

Grüße