Microsoft Office Forums - View Single Post - [Solved] accessing avery label table in macro

Guessed · 08-07-2022, 10:21 PM

Try this code. It assumes your cursor is in a cell you have already populated and then asks for how many tickets to add. It makes sure there are enough cells remaining in the table and then duplicates the current cell contents into the required cells.

Code:

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