Create sheet with info base on list

[mdorey]

Hello all,

It is been long time since i came here asking your help. I hope i can find once again help from you all.

I'll put it by steps:

Step 1: I need help to create a VBA that will copy a Template sheet to a new workbook (as many times the list has starting on row 2 until the last) the list will extrated from my work program.

Step 2: For each sheet created copy the info from Column C of that row to the sheat created C3, Column AC to E3, Column M to G3. And for last, on the list that i have exported in column G i have a list of names with the format Surname and Name seperated by comma, the surname would be paste on A5 and the name on the A7.

Many thanks for any attention on this matter,
Have a nice day

 

[mdorey]

Anyone please?

 

[DanteAmor]

Try this.

Change the data in red for your data.
The files will be saved in the same folder where you have the book with the macro. The name of each file will be the data of the list.

Sub Create_Sheet()
    Dim l1 As Workbook, l2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim c As Range, wNames As Variant
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set l1 = ThisWorkbook
    Set sh1 = l1.Sheets("[COLOR=#ff0000]List[/COLOR]")         'sheet with the list of data
    Set sh3 = l1.Sheets("[COLOR=#ff0000]Template[/COLOR]") 'template sheet
    
    For Each c In sh1.Range("[COLOR=#ff0000]A[/COLOR]2", sh1.Range("[COLOR=#ff0000]A[/COLOR]" & Rows.Count).End(xlUp))
        sh3.Copy
        Set l2 = ActiveWorkbook
        Set sh2 = l2.Sheets(1)
        wNames = Split(sh1.Range("G" & c.Row).Value, ",")
        sh2.Range("C3").Value = sh1.Range("C" & c.Row).Value
        sh2.Range("E3").Value = sh1.Range("AC" & c.Row).Value
        sh2.Range("G3").Value = sh1.Range("M" & c.Row).Value
        sh2.Range("A5").Value = wNames(0)
        sh2.Range("A7").Value = IIf(UBound(wNames) = 1, wNames(1), "")
        l2.SaveAs l1.Path & "\" & c.Value
        l2.Close False
    Next
    MsgBox "End"
End Sub

 

[mdorey]

Hello And many thanks for the work.

It does the job :D however there are few things that if that is possible would be fantastic...

When creating the new sheets is it possible to be all in the same workbook and leave it open?

The Value of the C column is it possible to not copy the first 4 caracters?

Many thanks for your attention and work on this

 

[DanteAmor]

Hello And many thanks for the work.

It does the job :D however there are few things that if that is possible would be fantastic...

When creating the new sheets is it possible to be all in the same workbook and leave it open?

The Value of the C column is it possible to not copy the first 4 caracters?

Many thanks for your attention and work on this

Of course.
Try this

Sub Create_Sheet()
    Dim l1 As Workbook, l2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim c As Range, wNames As Variant
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set l1 = ThisWorkbook
    Set sh1 = l1.Sheets("List")         '
    Set sh3 = l1.Sheets("Template")
    
    For Each c In sh1.Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))
        sh3.Copy
        Set l2 = ActiveWorkbook
        Set sh2 = l2.Sheets(1)
        wNames = Split(sh1.Range("G" & c.Row).Value, ",")
        sh2.Range("C3").Value = [COLOR=#0000ff]Mid(sh1.Range("C" & c.Row).Value, 5)[/COLOR]
        sh2.Range("E3").Value = sh1.Range("AC" & c.Row).Value
        sh2.Range("G3").Value = sh1.Range("M" & c.Row).Value
        sh2.Range("A5").Value = wNames(0)
        sh2.Range("A7").Value = IIf(UBound(wNames) = 1, wNames(1), "")
    Next
    MsgBox "End"
End Sub

 

[mdorey]

Thanks again

However they are opening in diffrent windows can they open all in the same new workbook? The new ones in a single new workbook??

Thanks and sorry for the trouble...

 

[DanteAmor]

Thanks again

However they are opening in diffrent windows can they open all in the same new workbook? The new ones in a single new workbook??

Thanks and sorry for the trouble...

It was not indicated in your requirement.


Sure you want all the sheets in one book?

I need help to create a VBA that will copy a Template sheet to a new workbook

 

[mdorey]

that is true... i didn't explain it well and i'm really sorry for that.

If all new sheets that will be copied could be to the very same new workbook that would set the trouble ray: that's because after that i have to keep the daily file with all the info.

Can that be done?

once again many thanks for all of your help

 

[DanteAmor]

Try this

Sub Create_Sheet()
    Dim l1 As Workbook, l2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim c As Range, wNames As Variant
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set l1 = ThisWorkbook
    Set sh1 = l1.Sheets("List")         '
    Set sh3 = l1.Sheets("Template")
    
    Set l2 = Workbooks.Add
    
    For Each c In sh1.Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))
        sh3.Copy after:=l2.Sheets(l2.Sheets.Count)
        Set sh2 = l2.Sheets(l2.Sheets.Count)
        wNames = Split(sh1.Range("G" & c.Row).Value, ",")
        sh2.Range("C3").Value = Mid(sh1.Range("C" & c.Row).Value, 5)
        sh2.Range("E3").Value = sh1.Range("AC" & c.Row).Value
        sh2.Range("G3").Value = sh1.Range("M" & c.Row).Value
        sh2.Range("A5").Value = wNames(0)
        sh2.Range("A7").Value = IIf(UBound(wNames) = 1, wNames(1), "")
    Next
    MsgBox "End"
End Sub

 

[mdorey]

It did put them all in the same file

However it created another 31 blank sheets besides the copied ones...