Hallo,

hab' ich fast befürchtet,
das macht das ganze etwas komplexer,
da Du alle Positionen  einzeln ansprechen mußt:
(Dazu ist der Kommentar eigentlich nicht unbedingt geeignet..)

Option Explicit

Private strBlattname As String
Private strKommentar As String
 
Public Sub InhaltAuslesen(ByVal intRow As Integer)
strBlattname = "Sheet1"  'SheetName  anpassen!!!
 With Worksheets(strBlattname)
    strKommentar = _
    .Cells(1, 2).Value & String$(10, " ") & .Cells(1, 3).Value & Chr(10) _
    & .Cells(intRow, 2).Value & String$(12, " ") & .Cells(intRow, 3).Value & Chr(10) & Chr(10) _
    & .Cells(1, 9).Value _
    & String$(20, " ") _
    & .Cells(1, 4).Value & Chr(10) _
    & .Cells(intRow, 9).Value & .Cells(intRow, 10).Value _
    & String$(16, " ") _
    & .Cells(intRow, 4).Value & Chr(10) & Chr(10) _
    & .Cells(1, 6).Value & Chr(10) & .Cells(intRow, 6).Value & Chr(10) & Chr(10) _
    & .Cells(1, 5).Value & Chr(10) & .Cells(intRow, 5).Value & Chr(10) & Chr(10) _
    & .Cells(1, 8).Value & Chr(10) & .Cells(intRow, 8).Value & Chr(10) _
    & .Cells(1, 7).Value & Chr(10) & .Cells(intRow, 7).Value
End With
Call CreateComment(intRow)
End Sub

Public Sub CreateComment(ByVal intRow As Integer)
Dim objComment As Comment
Dim lngIndex As Long, lngMax As Long
Dim lngArrStart(1 To 2) As Long, _
  lngArrLength(1 To 2) As Long
With Worksheets("Sheet2").Cells(2, 2)
    If Not .Comment Is Nothing Then Exit Sub
    Set objComment = .AddComment(strKommentar)
End With
With objComment.Shape.TextFrame
    With .Characters.Font
        .Bold = True
        .Underline = xlUnderlineStyleSingle
    End With
    If intRow > 1 Then _
      lngMax = 7 _
    Else: lngMax = 4
    For lngIndex = 1 To lngMax
       With Worksheets(strBlattname)
           Select Case lngIndex
               Case Is = 1
                  lngArrStart(1) = Len(.Cells(1, 2).Text) + 1: lngArrLength(1) = 10
                  If intRow > 1 Then
                    lngArrStart(2) = Len(.Cells(1, 2).Text) + 10 + _
                       Len(.Cells(1, 3).Text) + 2
                    lngArrLength(2) = Len(.Cells(intRow, 2).Text)
                  End If
               Case Is = 2
                  lngArrStart(1) = lngArrStart(1) + lngArrLength(1) + Len(.Cells(1, 3).Text) _
                      + Len(.Cells(intRow, 2).Text) + 1
                  lngArrLength(1) = 12
                  If intRow > 1 Then
                    lngArrStart(2) = lngArrStart(2) + lngArrLength(2) + 12
                    lngArrLength(2) = Len(.Cells(intRow, 3).Text)
                  End If
               Case Is = 3
                  lngArrStart(1) = lngArrStart(1) + lngArrLength(1) + Len(.Cells(intRow, 3).Text) + _
                      2 + Len(.Cells(1, 9).Text)
                  lngArrLength(1) = 20
                  If intRow > 1 Then
                    lngArrStart(2) = lngArrStart(2) + lngArrLength(2) + 2 + Len(.Cells(1, 9).Text) + _
                       20 + Len(.Cells(1, 4).Text)
                    lngArrLength(2) = Len(.Cells(intRow, 9).Text) + Len(.Cells(intRow, 10).Text) + _
                       16 + Len(.Cells(intRow, 4).Text) + 2
                  End If
               Case Is = 4
                  lngArrStart(1) = lngArrStart(1) + lngArrLength(1) + Len(.Cells(1, 4).Text) + _
                       1 + Len(.Cells(intRow, 9).Text) + Len(.Cells(1, 10).Text)
                  lngArrLength(1) = 16
                  If intRow > 1 Then
                    lngArrStart(2) = lngArrStart(2) + lngArrLength(2) + 1 + Len(.Cells(1, 6).Text) + 1
                    lngArrLength(2) = Len(.Cells(intRow, 6).Text)
                  End If
               Case Is = 5
                  lngArrStart(2) = lngArrStart(2) + lngArrLength(2) + 2 + Len(.Cells(1, 5).Text) + 1
                  lngArrLength(2) = Len(.Cells(intRow, 5).Text)
               Case Is = 6
                  lngArrStart(2) = lngArrStart(2) + lngArrLength(2) + 2 + Len(.Cells(1, 8).Text) + 1
                  lngArrLength(2) = Len(.Cells(intRow, 8).Text)
               Case Is = 7
                  lngArrStart(2) = lngArrStart(2) + lngArrLength(2) + 1 + Len(.Cells(1, 7).Text) + 1
                  lngArrLength(2) = Len(.Cells(intRow, 7).Text)
           End Select
       End With
       If lngIndex <= 4 Then _
         .Characters(Start:=lngArrStart(1), Length:=lngArrLength(1)).Font.Underline = xlUnderlineStyleNone
       If intRow > 1 Then
         With .Characters(Start:=lngArrStart(2), Length:=lngArrLength(2)).Font
             .Bold = False
             .Underline = xlUnderlineStyleNone
         End With
       End If
    Next
End With
Set objComment = Nothing
End Sub

Gruß,