With ActiveDocument
  For Each Tbl In .Tables
    With Tbl
      bFit = .AllowAutoFit
      .AllowAutoFit = False
      j = .Rows.Count
      For i = 1 To j
        Application.StatusBar = "Processing row " & i & " of " & j
        With .Cell(i, 2).Range
          MsgBox .Paragraphs.Count
          If .Paragraphs.Count = 2 Then
            With .Paragraphs(1).Range
              With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Format = False
                .Forward = True
                .Wrap = wdFindStop
                .MatchWildcards = True
                .Text = "WO [0-9]{7,10} [A-Z0-9]{2}"
                .Execute
              End With
              If .Find.Found Then
                StrTxt = Replace(.Text, Chr(32), "")
                Set xlRng = xlWkSht.Range("A1:A" & lRow).Find(What:=StrTxt, _
                  LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False)
                If Not xlRng Is Nothing Then
                  l = xlRng.Row
                  With xlWkSht
                    'Get the worksheet data from columns 3 & 2
                    StrTxt = .Cells(l, 3).Text
                    If (StrTxt <> "") And (.Cells(l, 2).Text <> "") Then StrTxt = StrTxt & vbCr
                    StrTxt = StrTxt & .Cells(l, 2).Text
                    'Add the worksheet data from columns 3 & 2 to column 5 of the table
                    With Tbl.Cell(i, 5).Range
                      If Len(.Text) > 2 Then
                        .InsertBefore StrTxt & vbCr
                      Else
                        .InsertBefore StrTxt
                    End If
                    End With
                    'Get the worksheet data from columns 4 & 5
                    StrTxt = .Cells(xlRng.Row, 4).Text
                    If (StrTxt <> "") And (.Cells(l, 5).Text <> "") Then
                      StrTxt = StrTxt & vbCr & "Er.Prio: "
                    ElseIf .Cells(l, 5).Text <> "" Then
                      StrTxt = "Er.Prio: "
                    End If
                    StrTxt = StrTxt & .Cells(l, 5).Text
                    'Add the worksheet data from columns 4 & 5 to column 4 of the table
                    With Tbl.Cell(i, 4).Range
                      If Len(.Text) > 2 Then
                        .InsertBefore StrTxt & vbCr
                      Else
                        .InsertBefore StrTxt
                      End If
                    End With
                  End With
                End If
              End If
            End With
          End If
        End With
      Next
      .AllowAutoFit = bFit
    End With
  Next
End With