Report

A macro to create new, copy and name worksheets based on a list [Solved]

Ask a question chottabeem 5Posts Tuesday July 19, 2016Registration date July 22, 2016 Last seen - Last answered on May 11, 2017 at 12:52 AM by vcoolio
Greetings,
I need a macro that can automatically create new, copy (existing worksheet say '100') and rename the new worksheets, based on a list that exists in another sheet ("Summary") of the same workbook? The list begins from '100' at cell A2. How can this be implemented under Excel?

It will be great-full, if I am be helped with the solution.
See more 
Helpful
+1
plus moins
Hello Chottabeem,

Assuming that you only want to create and name new sheets from the list in the Summary sheet, then the following code will do that:-

Sub CreateNameNewSheets()

    Dim LR As Long
    Dim c As Range
    Dim ws As Worksheet
LR = Range("A" & Rows.Count).End(xlUp).Row
    
For Each c In Range("A2:A" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c
End Sub


If you intend to use just numbers as the sheet names, then you will need to format those numbers as text otherwise, each time that you run the code, you will have additional and unwanted sheets added that will just have sheet numbers as names.

Run the code from the Summary sheet.

I hope that this helps.

Cheerio,
vcoolio.
Was this answer helpful?  
chottabeem 5Posts Tuesday July 19, 2016Registration date July 22, 2016 Last seen - Jul 21, 2016 at 03:06 AM
Hi Vcoolio,

Thanks for immediate reply. The code works good and creates new worksheets listed in "Summary".

Please refer to my file (shared as link http://speedy.sh/xcHkc/Macro-Temp.xlsm ) there are two sheets"Summary" consists of list and "Sheet1" having data.

The existing "Sheet1" (with data) to be renamed and copied along with data for the list in "Summary" (like, 10, 20, 30, 40.... 200)

Hope I clarified and expect the right solution.
Reply
Leave a comment
Helpful
+1
plus moins
Hello Chottabeem,

You're welcome. Glad that I could help.

I'll leave it to you to mark this thread as solved.

Cheerio,
vcoolio.
Was this answer helpful?  
Leave a comment
Helpful
+0
plus moins
Hello Chottabeem,

Could you please supply a sample of your work book (be careful with any sensitive data) outlining exactly what you would like to do.

Upload a sample to a free file sharing site such as DropBox, ge.tt or SpeedyShare and then post the link to your file back here.

We should then be able to help you.

Cheerio,
vcoolio.
chottabeem 5Posts Tuesday July 19, 2016Registration date July 22, 2016 Last seen - Jul 21, 2016 at 12:34 AM
Greetings,
Thanks for your reply. I'm posting the link to the sample file.
http://speedy.sh/xcHkc/Macro-Temp.xlsm

Regards
Reply
Leave a comment
Helpful
+0
plus moins
Hello Chottabeem,

I don't follow what you are trying to do. Are you saying that you would like the data in sheet1 transferred to each newly created sheet for each Supplier?

Cheerio,
vcoolio

P.S.
"Hope I clarified and expect the right solution."

Just a tip. Never use the word "expect" in any Forum such as this.
On this Forum, and all others like it, the people who help others such as yourself, are all Volunteers and give their time freely whenever they can to help. Hence, Posters are not in a position to expect anything.

Please familiarise yourself with the Charter.

I trust that you understand.
chottabeem 5Posts Tuesday July 19, 2016Registration date July 22, 2016 Last seen - Jul 21, 2016 at 05:52 AM
Yes

P.S: Noted
Reply
Leave a comment
Helpful
+0
plus moins
Hello Chottabeem,

I assume that you have answered "yes" to my question. If so, would you not prefer to name each sheet after each Supplier (or at least use a Supplier ID). You would not then need a Summary sheet. You could just use sheet1 as an Input sheet and perhaps name it Data Input.
Any new data that you enter, even for new Suppliers, could be quickly updated with the click of a button.

This would simplify the whole process for you.

Let us know what you think of this approach.

Cheerio,
vcoolio.
Leave a comment
Helpful
+0
plus moins
Hello Chottabeem,

I have attached your work book (see the link below) with some minor changes which I think you will like:-

https://www.dropbox.com/s/dwpzvk2qsmg3i8m/Chottabeem%28create%20shts.%2C%20transfer%20data%2C%20autofilter%29.xlsm?dl=0

I have added the following code which creates the new sheets and transfers the relevant data to each individual sheet:-

Option Explicit
Sub CreateSheetsCopyData()

        Dim ar As Variant
        Dim i As Integer
        Dim LR As Long
        Dim c As Range
        Dim ws As Worksheet, ws1 As Worksheet

Set ws1 = Worksheets("Data Input")
LR = ws1.Range("B" & Rows.Count).End(xlUp).Row
ar = ws1.Range("B6", ws1.Range("B" & ws1.Rows.Count).End(xlUp))

Application.ScreenUpdating = False

For Each c In ws1.Range("B6:B" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c

For i = 0 To UBound(ar)
         Sheets(ar(i, 1)).UsedRange.ClearContents
         ws1.Range("B5", ws1.Range("B" & ws1.Rows.Count).End(xlUp)).AutoFilter 1, ar(i, 1)
         ws1.[A5].CurrentRegion.Copy Sheets(ar(i, 1)).Range("A" & Rows.Count).End(xlUp)
         Sheets(ar(i, 1)).Columns.AutoFit
    Next i
ws1.[B5].AutoFilter
ws1.Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Sheets created/Data transfer completed!", vbExclamation, "Status"

End Sub


You may notice that I have re-named sheet1 as "Data Input" and your previous Summary sheet to "List". The "List" sheet simply lists your Suppliers' names and an ID which I randomly created with the numbers that you already had in the sheet. The main reason for placing an "A" in front of the numbers is so that the IDs are recognised as text otherwise the code will falter.

In the "Data Input" sheet, I have inserted a column (named Supplier ID) before the Suppliers Name column and placed the Supplier IDs in this column. You can change the IDs to suit yourself but remember to include some text in them.

As some of your Suppliers' names surpass the 31 character limit for sheet tab names, the code will hence search and filter for the Supplier IDs, create new sheets named after the IDs and then transfer the relevant data for each Supplier to their individual sheet.

You may also notice that I have unmerged the column headings row as merged cells play havoc with VBA coding. As you can see, it hasn't made much difference to your formatting. I have also "unwrapped" all text over the entire sheet as this was previously randomly placed over the data set for no apparent reason.

In the sample file in the link mentioned above, just click on the "RUN" button to see it all work. The code is in Module1.

I hope that this helps.

Cheerio,
vcoolio.
chottabeem 5Posts Tuesday July 19, 2016Registration date July 22, 2016 Last seen - Jul 22, 2016 at 02:36 AM
Hi Vcoolio,

Thanks a ton. This works good.
Reply
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 7, 2017 at 10:43 PM
http://static.ccm2.net/ccm.net/pictures/jHhuPWU3IFI7pHv6AowiMVNd5bbq43jxhp00jZwts7j4jsYgQlGxQQukSd5mD8nd-cap2.png

hi.. ive made some changes to sl no. column.. the requirement is i need to filter different supplier id according to different sl no.. which means supplier id A70 will have two different sheets where one sheet will have sl no a1 and the other will have sl no. 2.. the sheet name can the supplier id or anything..the same with other supplier id too..so every supplier id will have different sl no. and they need to create new sheets according to them..so if a supplier id ex.A60 have three diiferent sl no. then that supplier id will have three sheets with same supplier id A60 and sl no. accordingly.. could you help?
Reply
Leave a comment
Helpful
+0
plus moins


hi.. ive made some changes to sl no. column.. the requirement is i need to filter different supplier id according to different sl no.. which means supplier id A70 will have two different sheets where one sheet will have sl no a1 and the other will have sl no. 2.. the sheet name can the supplier id or anything..the same with other supplier id too..so every supplier id will have different sl no. and they need to create new sheets according to them..so if a supplier id ex.A60 have three diiferent sl no. then that supplier id will have three sheets with same supplier id A60 and sl no. accordingly.. could you help?
Leave a comment
Helpful
+0
plus moins
Hello Devil77,

I believe that the following code, placed in a standard module and assigned to a button, should work for you:-

Option Explicit

Sub CreateSheetsTransferData()
        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        Dim ws As Worksheet
        Dim sh As Worksheet

Application.ScreenUpdating = False

lr = Range("A" & Rows.Count).End(xlUp).Row

ar = Sheet1.Range("I3", Sheet1.Range("I" & Sheet1.Rows.Count).End(xlUp))
Set sh = Sheet1

For i = LBound(ar) To UBound(ar)
        If Not Evaluate("ISREF('" & ar(i, 1) & "'!A1)") Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = ar(i, 1)
        End If
        Set ws = Worksheets(CStr(ar(i, 1)))
        sh.Range("I2:I" & lr).AutoFilter 1, ar(i, 1)
        sh.Range("A1", sh.Range("H" & sh.Rows.Count).End(xlUp)).Copy ws.[A1]
        ws.Columns.AutoFit
  Next i
sh.[I2].AutoFilter

Application.CutCopyMode = False
Application.ScreenUpdating = True
sh.Select
MsgBox "Sheets created/data transfer completed!", vbExclamation, "STATUS"

End Sub


Following is the link to a sample that I have created based on your explanation:-

https://www.dropbox.com/s/3oji4egtx1xyj4b/Devil77%28Create%20shts%20from%20list%2C%20transfer%20data%29.xlsm?dl=0

Click on the "RUN" button to see it work.

To create different sheets for the same supplier, I have used the TEXTJOIN function to basically concatenate the SI No, the Supplier ID and the Supplier Name to create a unique ID which will allow you to have separate sheets for the same Supplier. The relevant rows of data are then transferred to their respective individual sheet.

So, in Column I, which I have named "Sheet Name List", place the following formula in cell I3 and copy it down as far as you need:-

=TEXTJOIN("",TRUE,A3,B3,C3)


This will create the unique ID list for each Supplier which the code will use to create the new sheets.

Test it all in a copy of your work book first.

I hope that this helps.

Cheerio,
vcoolio.
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 8, 2017 at 01:44 AM
Hi.. i dont quite your idea..and the code only create for A1.. i have attached my file and code.. feel free to have a look.. so based on my file it will create two new sheets by filtering column I as it has two different id one is 532455 and 541466.. then 532455 has to refer to column H where it has id which start by number and id start by RMA..so it needs to create another two sheet where id for column I is 532455 and H start by RMA and different sheet for id in column H start with number.. same for the other id.. thank you..

https://www.dropbox.com/s/lmtg49d90xujb5y/report2.xlsm?dl=0
Reply
Leave a comment
Helpful
+0
plus moins
Hello Devil77,

The first link that you supplied does not work and the second is completely different from the screen shot that you supplied, as is your explanation.
To make things simpler, in future please post your queries exactly and clearly as they should be. If you don't, how are we supposed to help? We cannot read minds!

In the sample that you supplied, why have you placed the code in the sheet module and not a standard module? If you place that same code in a standard module and delete it from the sheet module, it should create two new sheets based on the list of IDs in Column I.

As for the rest, you are going to have to give us a much clearer explanation.
You would be best to give us a manual (in a sample work book) example of the expected result.

Cheerio,
vcoolio.
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 8, 2017 at 03:44 AM
I am very sorry for the inconvenience.. this is my first time having a discussion in forum. I will surely correct my mistakes in the future. I have attached a word file with screenshots of expected outcomes. Hope you will find it helpful.


https://www.dropbox.com/s/hel5jfq7medw170/Original%20report.docx?dl=0
Reply
Leave a comment
Helpful
+0
plus moins
Hello Devil77,

Ok. Following is a "rough and ready" code which should get you started:-

Sub TransferData()

Dim i As Integer

Application.ScreenUpdating = False


Sheet2.Columns.AutoFit

For i = 2 To 96 '-----> Your data set appears to be set at 96 rows.

If Left(Cells(i, 8), 3) = "RMA" And Cells(i, 9) = 541466 Then
Range(Cells(i, 1), Cells(i, 17)).Copy Sheet3.Range("A" & Rows.Count).End(3)(2)
Sheet3.Columns.AutoFit

ElseIf Left(Cells(i, 8), 3) <> "RMA" And Cells(i, 9) = 541466 Then
Range(Cells(i, 1), Cells(i, 17)).Copy Sheet4.Range("A" & Rows.Count).End(3)(2)
Sheet4.Columns.AutoFit

ElseIf Left(Cells(i, 8), 3) <> "RMA" And Cells(i, 9) = 532455 Then
Range(Cells(i, 1), Cells(i, 17)).Copy Sheet5.Range("A" & Rows.Count).End(3)(2)
Sheet5.Columns.AutoFit

ElseIf Left(Cells(i, 8), 3) = "RMA" And Cells(i, 9) = 532455 Then
Range(Cells(i, 1), Cells(i, 17)).Copy Sheet6.Range("A" & Rows.Count).End(3)(2)
Sheet6.Columns.AutoFit

End If
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub


This code doesn't actually create new sheets so manually create one sheet formatted as per your "FG Report" sheet and then copy this sheet three more times. Name them what you like as I have used the sheet code in the macro above to reference the sheets so what they are named won't matter.

Place the above macro code in a standard module (not the sheet module) and assign it to a button or create a shortcut key to execute the code.

Again, test it in a copy of your work book first.

I hope that this helps.

Cheerio,
vcoolio.
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 9, 2017 at 03:42 AM
yes customers will have unique id.. but in one sheet there will be like maximum 4 customers..so that would be 8 new sheets.. the reason why code for column I needs to be dynamic is because this code can be used for different ID or different workbooks too..and in that workbook may contain 3 id in column I..but column H will surely be with RMA or without RMA..
Reply
vcoolio 989Posts Thursday July 24, 2014Registration date ModeratorStatus June 24, 2017 Last seen - May 9, 2017 at 09:52 AM
I'm still lost as to your reasoning.

Your quote:

but in one sheet there will be like maximum 4 customers..so that would be 8 new sheets.


If we create new sheets from the IDs in Column I, there will only be two new sheets created, Sheet 532455 and Sheet 541466 as there are only two customer IDs in Column I in the sample you supplied even though there are many entries. This will mean that there will be 85 entries in Sheet 532455 and 10 entries in Sheet 541466.

So, if we create new sheets from the IDs in Column H of both these sheets (with and without the RMA prefix), you will end up with some 51 sheets in total in this work book.

Is this the result that you were hoping for?
Reply
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 10, 2017 at 02:06 AM
no.. i have attached an excel file for you to see..hope this will give you the idea.. have look at the highlighted columns..

https://www.dropbox.com/s/6efn60twffessks/report2.xlsm?dl=0
Reply
vcoolio 989Posts Thursday July 24, 2014Registration date ModeratorStatus June 24, 2017 Last seen - May 10, 2017 at 09:23 AM
Hello Devil77,

I have just rushed the following code together for you. I haven't tested it but I'll have another look at it tomorrow evening for you. So, test it in the same sample of the work book that you supplied at the above Drop Box link.

Sub TransferData()

Application.ScreenUpdating = False

            Dim LR As Long
            Dim MySheet As String
            Dim cell As Range
            Dim c As Range
            Dim ws As Worksheet
            
Sheet2.Range("T2:T96").Formula = "=IF(LEFT(H2,3)=""RMA"",""RMA"",""Non-RMA"")&I2"

LR = Sheet2.Range("T" & Rows.Count).End(xlUp).Row

For Each c In Sheet2.Range("T2:T" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c

Worksheets.FillAcrossSheets Sheet2.[A1:Q1]

For Each cell In Sheet2.Range("T2:T" & LR)
    MySheet = cell.Value
        cell.EntireRow.Copy Sheets(MySheet).Range("A" & Rows.Count).End(3)(2)
               Sheets(MySheet).Columns.AutoFit
Next cell

Sheet2.Range("T2:T96").ClearContents

MsgBox "Data transfer completed."

Application.CutCopyMode = False
Application.ScreenUpdating = True

Sheet2.Select

End Sub


To name the sheets something appropriate, I have used Column T as a helper column and inserted a formula to the extent of the data set. The formula uses both Columns H and I to create the sheet names (as you will see) and the code uses these names to create the new sheets.

The end result should be as per your last sample.

I hope that this helps and, as I said above, I will check it tomorrow evening for you.

Cheerio,
vcoolio.
Reply
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 10, 2017 at 10:17 PM
Hi there it works fine.. but there is one problem..value of column H being pasted in Column T when data is transferred..im sure u can see it too when you run the code..just that minor problem..huge thanks for the rest of the code..and i have another question..is there a to paste the datas in different range.. what i want is i the data transferred i want it to be pasted starting from range A8:Q8 instead of A1:Q1.. is there a way to do that..
Reply
Leave a comment
Helpful
+0
plus moins
Hello Devil77,

I have tested the code and I don't have any errors arising. Did you use the code in post #28?

Regardless, following is a more compact code which will do the same task:-


Sub CreateSheetsTransferData()
        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        Dim ws As Worksheet
        Dim sh As Worksheet

Application.ScreenUpdating = False

Sheet2.Range("T2:T96").Formula = "=IF(LEFT(H2,3)=""RMA"",""RMA"",""Non-RMA"")&I2"
lr = Range("A" & Rows.Count).End(xlUp).Row

ar = Sheet2.Range("T2", Sheet2.Range("T" & Sheet2.Rows.Count).End(xlUp))
Set sh = Sheet2

For i = LBound(ar) To UBound(ar)
        If Not Evaluate("ISREF('" & ar(i, 1) & "'!A1)") Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = ar(i, 1)
        End If
        Set ws = Worksheets(CStr(ar(i, 1)))
        sh.Range("T1:T" & lr).AutoFilter 1, ar(i, 1)
        sh.[A1].CurrentRegion.Copy ws.[A8]
        ws.Columns.AutoFit
  Next i
    
sh.[T1].AutoFilter
sh.Columns(20).ClearContents

Application.CutCopyMode = False
Application.ScreenUpdating = True
sh.Select
MsgBox "All done!", vbExclamation, "STATUS"

End Sub


Let me know how it goes.

Cheerio,
vcoolio.
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 10, 2017 at 11:44 PM
it works amazingly fine..thank you very much..very much appreciated..
Reply
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 11, 2017 at 12:05 AM
Sheet2.Range("T2:T96").Formula = "=IF(LEFT(H2,3)=""RMA"",""RMA"",""NonRMA"")&I2"

Im tryin to put ("T2:T" & lr) in the code istead of ("T2:T96")..but its not working..is there a way to do that..because in different workbook the number of rows are different..thank you..
Reply
vcoolio 989Posts Thursday July 24, 2014Registration date ModeratorStatus June 24, 2017 Last seen - May 11, 2017 at 12:07 AM
Which code did you use?
Reply
Devil77 14Posts Sunday May 7, 2017Registration date May 11, 2017 Last seen - May 11, 2017 at 12:38 AM
the latest code you provided..
Reply
vcoolio 989Posts Thursday July 24, 2014Registration date ModeratorStatus June 24, 2017 Last seen - May 11, 2017 at 12:52 AM
Try replacing this line of code
Sheet2.Range("T2:T96").Formula = "=IF(LEFT(H2,3)=""RMA"",""RMA"",""Non-RMA"")&I2"


with

lr1 = Sheet2.Range("Q" & Rows.Count).End(xlUp).Row
Sheet2.Range("T2:T" & lr1).Formula = "=IF(LEFT(H2,3)=""RMA"",""RMA"",""Non-RMA"")&I2"


But first declare another variable:-
At the top of the code, add the following variable to the list of "Dims":-
Dim lr1 As Long

This should do the trick for you.
Let me know how it goes.
Reply
Leave a comment

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!