Sub AddTickets()
  Dim i As Integer, iCount As Integer, celSrc As Cell, celAdd As Cell
  Dim rngCell As Range, rngToEnd As Range, aTbl As Table
  Set aTbl = Selection.Tables(1)
  Set celSrc = Selection.Cells(1)
  Set rngCell = celSrc.Range
  rngCell.MoveEnd Unit:=wdCharacter, Count:=-1
  Set rngToEnd = rngCell.Duplicate
  rngToEnd.End = aTbl.Range.End
  iCount = InputBox("How many tickets do I need?", "Ticket Copier", 2)
  If iCount > 1 Then
    Do While rngToEnd.Cells.Count < iCount
      aTbl.Rows.Add
      rngToEnd.End = aTbl.Range.End
    Loop
    Set celAdd = celSrc.Next
    For i = 2 To iCount
      celAdd.Range.FormattedText = rngCell
      Set celAdd = celAdd.Next
    Next i
  End If
End Sub