Sub Demo()
Dim wdDoc As Document, Tbl As Table, Rng As Range, i As Long, j As Long, k As Long
Application.ScreenUpdating = False
Set wdDoc = ActiveDocument
With wdDoc
  For i = .Tables.Count To 1 Step -1
    With .Tables(i).Range
      j = (.Cells(.Cells.Count).RowIndex - 1) / 2
      .Paragraphs.Last.Next.Range.InsertBefore vbCr & vbCr & vbCr & vbCr
      Set Rng = .Paragraphs.Last.Next.Next.Range
      Rng.Collapse wdCollapseStart
      Set Tbl = wdDoc.Tables.Add(Range:=Rng, NumRows:=2, NumColumns:=4, AutoFitBehavior:=False)
      With Tbl
        .Borders.Enable = True
        .Rows.HeightRule = wdRowHeightExactly
        .Rows(1).Height = InchesToPoints(0.25)
        .Rows(2).Height = InchesToPoints(0.5)
        .Cell(2, 1).VerticalAlignment = wdCellAlignVerticalCenter
        .Columns.PreferredWidthType = wdPreferredWidthPoints
        .Rows(1).Shading.BackgroundPatternColorIndex = wdTurquoise
        .Columns(1).Shading.BackgroundPatternColorIndex = wdTurquoise
        .Columns(1).Width = InchesToPoints(0.45)
        .Columns(2).Width = InchesToPoints(1.5)
        .Columns(3).Width = InchesToPoints(2.38)
        .Columns(4).Width = InchesToPoints(2.33)
        Set Rng = .Range
        With Rng
          .SetRange Start:=.Cells(6).Range.Start, End:=.Cells(8).Range.End
          .Cells.Split NumRows:=2, NumColumns:=1, MergeBeforeSplit:=False
          .Rows.HeightRule = wdRowHeightExactly
          .Cells.Height = InchesToPoints(0.25)
          .SetRange Start:=Tbl.Range.Cells(9).Range.Start, End:=Tbl.Range.End
          .Cells.Merge
          .SetRange Start:=Tbl.Range.Cells(5).Range.Start, End:=Tbl.Range.End
          .Copy
        End With
        For k = 2 To j
          With .Range.Paragraphs.Last.Next.Range
            .InsertBefore vbCr
            .Paste
          End With
        Next
      End With
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

With .Range.Paragraphs.Last.Next.Range
            .InsertBefore vbCr

Sub Demo()
Application.ScreenUpdating = False
Dim wdDoc As Document, Tbl As Table, sWdth(), i As Long, Rng As Range
'Store all the widths used. 1st item = table width
'2nd - 5th items = individual cell widths
'6th item = sum of of 3rd - 5th items
sWdth = Array(6.66, 0.45, 1.5, 2.38, 2.33, 6.21)
Set wdDoc = ActiveDocument
With wdDoc
  For Each Tbl In .Tables
    With Tbl
      'Give the cells an all-round interior padding
      .TopPadding = InchesToPoints(0.05)
      .BottomPadding = InchesToPoints(0.05)
      .LeftPadding = InchesToPoints(0.05)
      .RightPadding = InchesToPoints(0.05)
      .Spacing = 0
      'Switch off autofit
      .AllowAutoFit = False
      'set the preferred width type
      .PreferredWidthType = wdPreferredWidthPoints
      'set the preferred width value to the specified array value
      .PreferredWidth = InchesToPoints(sWdth(0))
      With .Rows
        'Remove any table indenting
        .LeftIndent = 0
        'Center the table on the page
        .Alignment = wdAlignRowCenter
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        'Give the cells automatic heights, so they'll fit their contents
        .HeightRule = wdRowHeightAuto
      End With
      With .Range
        'Ensure the first row functions as a heading row
        .Cells(1).Select: Selection.Rows.HeadingFormat = True
        'Format the first four cells
        For i = 1 To 4
          .Cells(i).Width = InchesToPoints(sWdth(i))
        Next
        'Format the remaining cells, in groups of 5.
        'The first cell in each group spans two rows and
        'the first row in each group contains 4 cells but
        'the second row contains 1 cell spanning the width
        'of the last 3 cells of the first row
        For i = 5 To .Cells.Count
          'If it's the first cell in a group, ensure it's both merged and centred vertically
          If ((i Mod 5) + 1) = 1 Then
            If .Cells(i + 4).ColumnIndex = 1 Then
              Set Rng = .Cells(i).Range
              Rng.End = .Cells(i + 4).Range.End
              Rng.Select: Selection.Cells.Merge
            End If
            .Cells(i).VerticalAlignment = wdCellAlignVerticalCenter
          End If
          'Specify a minimum height for the last cell in the group
          If ((i Mod 5) + 1) = 5 Then
            .Cells(i).SetHeight Rowheight:=InchesToPoints(0.5), HeightRule:=wdRowHeightAtLeast
          End If
          .Cells(i).Width = InchesToPoints(sWdth((i Mod 5) + 1))
          'If we've merged any cells, the count will have changed
          If i = .Cells.Count Then Exit For
        Next
      End With
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

Tbl.Rows(1).HeadingFormat = True

If Case 1: .Cells.Merge = False Then
            .Cells.Merge
            Else Next

If .Cells().Width = InchesToPoints(6.21) Then
                    .Cells.Height = InchesToPoints(0.8)
                End If