It would have been helpful had you specified your requirements in full from the outset. Try:
Code:
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
PS: There is no need to quote every post you reply to - doing so just adds clutter.