A macro to create new, copy and name worksheets based on a list [Solved/Closed]
chottabeem5
Posts Tuesday July 19, 2016Registration date
July 22, 2016
Last seen
-
Jul 19, 2016 at 02:24 AM - Latest reply: vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen
- May 11, 2017 at 12:52 AM
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.
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.
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)
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.
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.
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.
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?
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?
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:-
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.
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..
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.
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.
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.
hi..it works fine..thank you..but then i have a small problem with this..the code for the ID from column I has to be dynamic.. because if I use the code for other workbook and if that workbook has column I with more than 2 ID's then this wont work..and if it has 20 different ID's then it will be not efficient to type in if else for each id..could you help with that?
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen
>
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen -May 9, 2017 at 01:52 AM
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen
>
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen -May 9, 2017 at 02:09 AM
yes..bacause column H will be either start with RMA or number..so that is fine..but then column I could have many id..
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen
>
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen -May 9, 2017 at 02:33 AM
Or it would be really helpful if you can show a way to edit this code and add a filter for column H too which correspond with column I. Because i really need to create new sheets according to the requirements. Thank you.
Sub MockInvoice()
Dim ar As Variant
Dim i As Integer
Dim LR As Integer
Dim range1 As Range
Dim c As Range
Dim ws As Worksheet, ws1 As Worksheet
Set ws1 = Worksheets("FGReport")
LR = ws1.Range("I" & Rows.Count).End(xlUp).Row
ar = ws1.Range("I2", ws1.Range("I" & ws1.Rows.Count).End(xlUp))
Application.ScreenUpdating = False
For Each c In ws1.Range("I2:I" & 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("I1", ws1.Range("I" & ws1.Rows.Count).End(xlUp)).AutoFilter 1, ar(i, 1)
ws1.[A1].CurrentRegion.copy Sheets(ar(i, 1)).Range("A" & Rows.Count).End(xlUp)
Sheets(ar(i, 1)).Columns.AutoFit
Next i
ws1.[A1].AutoFilter
ws1.Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Invoice Created!", vbExclamation, "Status"
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen
>
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen -May 9, 2017 at 03:01 AM
Do you want to name the sheets after the IDs in Column I?
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen
>
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen -May 9, 2017 at 03:06 AM
yes please.. if it is not possible then it could be just sheet1,sheet2 and so forth..
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen
>
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen -May 9, 2017 at 03:36 AM
It is possible but, before we go any further, do you realise that you may end up with many, many sheets. I assume that you will have repeat clients with the same ID but you will no doubt have new clients in future requiring their own IDs. Is this correct or is your client base fairly stable?
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..
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen
>
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 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.
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen
>
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 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.
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen
>
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
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..
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
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..
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen
>
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen -May 11, 2017 at 12:07 AM
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen
>
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen -May 11, 2017 at 12:38 AM
vcoolio1173
Posts Thursday July 24, 2014Registration dateModeratorStatus
July 15, 2018
Last seen
>
Devil7714
Posts Sunday May 7, 2017Registration date
May 11, 2017
Last seen -May 11, 2017 at 12:52 AM
has helped 1670 users this month
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.