Sub ReformatTables()
Dim t As Long, i As Long, StrDrwgs As String, StrTypes As String
Dim StrEngineer As String, StrTED As String, StrTPD As String, Rng As Range
With ActiveDocument
  For t = .Tables.Count To 1 Step -1
    With .Tables(t)
      If Trim(Split(.Cell(1, 2).Range, Chr(13))(0)) = "Drawings" Then
        StrDrwgs = Trim(Split(.Cell(2, 2).Range, Chr(13))(0))
        StrTypes = Trim(Split(.Cell(2, 3).Range, Chr(13))(0))
        For i = 1 To UBound(Split(StrDrwgs, ","))
          With .Rows.Last.Range
            .Next.InsertBefore vbCr
            .Next.FormattedText = .FormattedText
          End With
          With .Rows.Last.Range
            .Cells(1).Range.Text = i + 1
            .Cells(2).Range.Text = Trim(Split(StrDrwgs, ",")(i))
            .Cells(3).Range.Text = Trim(Split(StrTypes, ",")(i))
          End With
        Next
        With .Rows(2).Range
          .Cells(1).Range.Text = 1
          .Cells(2).Range.Text = Trim(Split(StrDrwgs, ",")(0))
          .Cells(3).Range.Text = Trim(Split(StrTypes, ",")(0))
        End With
      End If
      If Trim(Split(.Cell(1, 2).Range, Chr(13))(0)) = "Project Engineer" Then
        .Split .Rows.Count
        StrEngineer = Trim(Split(.Cell(2, 2).Range, Chr(13))(0))
        StrTED = Trim(Split(.Cell(2, 3).Range, Chr(13))(0))
        StrTPD = Trim(Split(.Cell(2, 4).Range, Chr(13))(0))
        For i = 1 To UBound(Split(StrEngineer, ","))
          With .Rows.Last.Range
            .Next.InsertBefore vbCr
            .Next.FormattedText = .FormattedText
          End With
          With .Rows.Last.Range
            .Cells(2).Range.Text = Trim(Split(StrEngineer, ",")(i))
            .Cells(3).Range.Text = Trim(Split(StrTED, ",")(i))
            .Cells(4).Range.Text = Trim(Split(StrTPD, ",")(i))
          End With
        Next
        With .Rows(2).Range
            .Cells(2).Range.Text = Trim(Split(StrEngineer, ",")(0))
            .Cells(3).Range.Text = Trim(Split(StrTED, ",")(0))
            .Cells(4).Range.Text = Trim(Split(StrTPD, ",")(0))
        End With
        .Range.Characters.Last.Next.Delete
      End If
    End With
  Next
End With
End Sub