Need to create a separate worksheet for each row of data

[gameplayer85]

Hello
I am using Windows 10 with Office 2013. I have an Excel problem which I believe requires the use of Visual Basic. I have attached the sheet below. I have a list of data on the Claim data tab and an example template on the Template tab. What I need to do is create a template for each row of data in the Claim data tab and then pop in the data for each row in each template. The number of rows will fluctuate. I imagine we could use a macro button to create the templates and fill in each row of data. I added a row counter in cell H5 on the Claim data tab.

Thanks in advance for any help

[Paul_Hossler]

Something like this maybe. Attachment has the macro and the results

Option Explicit

Sub GenerateClaims()

    Dim wsTemplate As Worksheet
    Dim wsClaims As Worksheet
    Dim wsClaim As Worksheet
    Dim rClaims As Range, rClaim As Range
    Dim sClaimSheet As String

    Application.ScreenUpdating = False

    Set wsTemplate = Worksheets("Template")
    Set wsClaims = Worksheets("Claim Data")
    
    Set rClaims = wsClaims.Range("B4").CurrentRegion
    Set rClaims = rClaims.Cells(2, 1).Resize(rClaims.Rows.Count - 1, rClaims.Columns.Count)
    
    For Each rClaim In rClaims.Rows
        With rClaim
            sClaimSheet = wsClaims.Name & "-" & Format(.Cells(1).Value, "000")

            'delete sheet if it exists
            On Error Resume Next
            Application.DisplayAlerts = False
            Worksheets(sClaimSheet).Delete
            Application.DisplayAlerts = True
            On Error GoTo 0
            
            'copy empty template
            wsTemplate.Copy before:=wsTemplate
            Set wsClaim = ActiveSheet
            wsClaim.Name = sClaimSheet
    
            'do all work on the copy
            wsClaim.Range("D6") = .Cells(2).Value
            wsClaim.Range("D7") = .Cells(3).Value
            wsClaim.Range("D8") = .Cells(4).Value
            wsClaim.Range("D9") = .Cells(5).Value
            
        End With
    Next
    Application.ScreenUpdating = True

End Sub

[snb]

Avoid merged cells.

This code suffices:

Sub M_snb()
   sn = Sheet2.ListObjects(1).DataBodyRange
   
   For j = 1 To UBound(sn)
       Sheets("template").Copy , Sheets(Sheets.Count)
       Sheets(Sheets.Count).Range("B2:B5") = Application.Transpose(Application.Index(sn, j, Array(2, 3, 4, 5)))
   Next
End Sub

[gameplayer85]

Thank you snb, this works well. I added the macro button and when I click on it, it creates each of the template sheets. The only issue is that it is putting the data in the range d6:d9 instead of b2:b5. How do I fix it? I can see that you've used b2:b5 but it isn't going there

Thanks again

[gameplayer85]

Also, is it possible to add a second macro that will delete all of the created template sheets once we have finished the work?

[gameplayer85]

Thank you Paul, this works well. What I would like ideally is a spreadsheet with just the first two tabs (template and claim data) when the user enters it. They would click on the macro button and it would then create all of the populated templates. Is this possible? I know enough to add the macro button and tie it to the code but I'm not a programmer

Thanks again

[gameplayer85]

Strange, I closed and then reopened your sheet and now its posting in the right place.

[Paul_Hossler]

Added a call to DeleteClaims in the WB open event so any existing claim sheets will be deleted

Also added 2 macro buttons to the Claims worksheet

Sub DeleteClaims()
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
    For Each ws In ThisWorkbook.Worksheets
        If UCase(ws.Name) <> "TEMPLATE" And UCase(ws.Name) <> "CLAIM DATA" Then
            On Error Resume Next
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
            On Error GoTo 0
        End If
    Next
    Application.ScreenUpdating = True
End Sub

[gameplayer85]

Paul,
Wow that is outstanding! Thanks for all of your help. I am marking this as solved. Isnt there a way to giver you kudos for this? Most sites allow me to add to your reputation or something like it
Thanks again!

[gameplayer85]

Paul, I just figured out how to upvote the thread. Thanks again

[snb]

Thank you snb, this works well. I added the macro button and when I click on it, it creates each of the template sheets. The only issue is that it is putting the data in the range d6:d9 instead of b2:b5. How do I fix it? I can see that you've used b2:b5 but it isn't going there

Thanks again

You didn't use the 'template' in the file I send.

To delete the new sheets:

Sub M_snb()
    For Each sh In Sheets
       c00 = c00 & "|" & sh.Name
    Next
    
    Application.DisplayAlerts = False
    Sheets(Filter(Split(c00, "|"), "Template (")).Delete
End Sub

[jolivanes]

Re: To delete the new sheets:

Sub M_snb() 
    For Each sh In Sheets 
        c00 = c00 & "|" & sh.Name 
    Next 
     
    Application.DisplayAlerts = False 
    Sheets(Filter(Split(c00, "|"), "Template (")).Delete
 
End Sub

I assume that this

Sheets(Filter(Split(c00, "|"), "Template (")).Delete

should be

Sheets(Filter(Split(c00, "|"), "Template")).Delete

But that deletes the Template sheet and leaves the rest in peace

[snb]

@Joli

Every copy of the sheet 'Template' get automatically the name "Template (1)", "Template (2)"

That why I can filter these using
Sheets(Filter(Split(c00, "|"), "Template (")).Delete

Excluding the Template sheet, its name not containing a space & a (

[jolivanes]

OK, thank you very much for the explanation.
It's (past) bedtime here so I'll have to get at it in the morning.
Thanks again

[jolivanes]

@snb

After inserting this

Sheets(Sheets.Count).Name = sn(j, 1)

in the code
this
"the name "Template (1)", "Template (2)""
is not valid anymore!!!!!!


Appreciate your time and explanation.