Inserting each excell row into a template

Microsoft Excel 010 - complete package
April 28, 2011 at 12:07:49
Specs: Windows 7, guad core/ 8gb
Hello!

I have a large excel file with signups for an event I'm throwing. There are about 400 rows, each with a group name, time they are showing up, and what they are using. I am trying to create a macro that will pull each row and paste it into a pre designed template, each row being on its own page, or even a half page that I can cut. Is this possible? I'm also trying to get it to have a bigger font size on the final template page so that it is large and very readable. Each page will be used for a "ticket" for each team that arrives at the event.

The second part to this is that some teams have signed up for multiple spots, but they are on the same row, specified in a "quantity" column. I would need rows that have multiple spots requested to have multiple "tickets". Is this possible either?

Thanks so much for anyone who knows how to do this! I am SO LOST!


See More: Inserting each excell row into a template

Report •


#1
April 28, 2011 at 12:32:08
The comments embedded in this code explain what each line does.

As long as you don't have any matching values in Column A of Sheet1, it should work fine.

I suggest you make a copy of your workbook and reduce the number of lines down to 4 or 5 just to see how it works before you run it against your 400 rows of data.

Sub TicketMaker()
'Determine how many rows of data in Sheet1
  lastRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Loop thorugh all rows on Sheet1
    For nxtRow = 1 To lastRow
'Add a Sheet
      Sheets.Add after:=Sheets(Sheets.Count)
'Name the new sheet based on the vlue in Column A
      ActiveSheet.Name = Sheets(1).Range("A" & nxtRow)
'Copy row from Sheet1 to Row 1 of new sheet
      Sheets(1).Range("A" & nxtRow).Copy _
        Destination:=ActiveSheet.Range("A1")
'Increase the font size of Row 1 to be 24
      ActiveSheet.Rows(1).Font.Size = 24
    Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
April 28, 2011 at 15:36:22
Thanks for the super fast reply!! This is a great start for me, but for some reason it is only moving over the first column from each row.
Would it be possible to have excel move these over into a template page I have already made instead of creating a new page? Or possibly into a word document that can contain all pages in one file? Either way I can make it work! Thanks so much

Report •

#3
April 28, 2011 at 16:07:56
As far as moving the rows into an existing template, that would mean that you would need to create ~400 templates first, right?

Why not create 1 template and then copy the template, rename it and then copy the data from each individual row into the new "template"?

I created a sheet named Template. The code copies that sheet after the last sheet and then pastes the rows from Sheet1 into Row 2 of each new template (based on the assumption that there is something in Row 1). Adjust as required.

It also picks up the "quantity" from Column D (adjust as desired) and uses that number to determine how many templates to create for each group. Since you can't have more than one sheet with the same name, it appends a number to the sheet name (1, 2, 3) as it renames them to avoid duplicates.

As written, you need a number in Column D for each group, even a 1. I'd autofill that column with a 1, and then you can just change it to a 2, 3, etc. as needed.

BTW...you can Select groups of sheets to print multiple sheets at the same time.

Sub TicketMaker2()
'Determine how many rows of data in Sheet1
  lastRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Loop through all rows on Sheet1
    For nxtRow = 1 To lastRow
'Determine how many templates to create for a group
     numTemps = Sheets(1).Range("D" & nxtRow)
       For CreateTik = 1 To numTemps
'Copy the Template Sheet(s)
        Sheets("Template").Copy after:=Sheets(Sheets.Count)
'Name the new template based on the value in Col A and Quantity in Col D
         ActiveSheet.Name = Sheets(1).Range("A" & nxtRow) & CreateTik
'Copy row from Sheet1 to Row 2 of new template
         Sheets(1).Range("A" & nxtRow).EntireRow.Copy _
          Destination:=ActiveSheet.Range("A2")
'Increase the font size of Row 2 to be 24
         ActiveSheet.Rows(2).Font.Size = 24
       Next
    Next
End Sub


Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
April 28, 2011 at 16:43:46
Absolutely beautiful! It works perfect! You don't know how many hours this saves me, We have always handwritten tickets in the past. I know where to go now for problems. You guys rock.

Report •


Ask Question