Macro to split table cells

macropod · #9 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
split row of cells at semicolon	lbeck	Excel	8	06-06-2015 01:55 PM
how to split merged data into vertical saperate cells	cheekugreat	Excel	5	10-11-2014 05:53 AM
Macro to loop through all cells in a table produced by a mail merge	elh52	Word VBA	4	08-31-2014 10:50 PM
Losing rows when pasting split cells	Gitley	Word Tables	1	01-15-2013 07:49 AM
Macro to Merge Cells Row By Row in a Table	KD999	Word VBA	4	02-20-2012 08:51 PM