Microsoft Office Forums - View Single Post

macropod · 03-08-2016, 02:21 AM

Try the following macro. Do be aware that your current table's Drawing 4, Drawing 27 & EC, C content is actually supplied via DOCPROPERTY fields pointing to properties named drawing_id and drawing_tmpl_type, respectively. Those fields cannot survive the restructuring.

Code:

Sub ReformatTables()
Dim t As Long, i As Long, StrDrwgs As String, StrTypes As String
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
    End With
  Next
End With
End Sub