Macro to create tabs and populate from other worksheets [Solved/Closed]

ibtrini 7 Posts Saturday August 17, 2013Registration date September 5, 2013 Last seen - Aug 19, 2013 at 10:10 AM - Latest reply:  Nickname
- Feb 26, 2015 at 04:42 AM
I already posted this on the programming forum but have not had any responses as yet so I am trying here as it may be more appropriate.

Current Setup:
File name (Data) with 2 worksheets (Data, Template)

Data worksheet has 1 column with country names and 12 other columns of pertinent info about the country (A3:M3). Each country has its own row of corresponding info.
e.g. Algeria (A3), other info on Algeria (B3:M3). Angola (A4), other info on Angola (B4:M4).

Template worksheet has partially-filled sections

Result desired:
1) Creation of worksheets named for each country from the Data worksheet. e.g. "Algeria", "Angola", etc.

2) Each newly created worksheets (Algeria, Angola...) should be populated with a copy of the partially-filled information from the "Template" worksheet before being automatically populated with that country's pertinent information (Data: B?:M?)

I am new to Excel and macros so it is not as easy for me to figure out. Can someone assist me with this please since I believe I almost have it done but I am having an issue with the column widths. Column A should be "50.43" with columns B-M being "2". All columns are being resized to "2".

Thanks.

Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("Data").Range("A3")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange

Sheets.Add After:=Sheets(Sheets.Count) ' worksheet creation
Sheets(Sheets.Count).Name = MyCell.Value ' worksheet renaming

Sheets("Template").Select
Range("A1:M80").Select
Selection.Copy
Sheets(Sheets.Count).Select
Range("A1").Select
ActiveSheet.Paste

Columns("A:A").Select
Range("A69").Activate
Selection.ColumnWidth = 50.43
Columns("B:M").Select
Range("B81").Activate
Selection.ColumnWidth = 2
Cells.Select
Range("A1:A80").Activate
Selection.Rows.AutoFit

Sheets("AFR").Select
Range("B3:M3").Select
Selection.Copy
Sheets(Sheets.Count).Select
Range("N69").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True


Next MyCell
End Sub
See more 

5 replies

TrowaD 2391 Posts Sunday September 12, 2010Registration dateContributorStatus July 12, 2018 Last seen - Aug 19, 2013 at 10:31 AM
0
Thank you
Hi Ibtrini,

"I already posted this on the programming forum"

You actually posted twice on the Office Software forum.
ibtrini 7 Posts Saturday August 17, 2013Registration date September 5, 2013 Last seen - Aug 19, 2013 at 04:51 PM
0
Thank you
Thanks for the quick response but the column resizing did not work. I am wondering if it has anything to do with the first row having a merged cell. Anyway, I noticed an even more urgent issue with my logic in the second part of my question.

2) Each newly created worksheets (Algeria, Angola...) should be populated with a copy of the partially-filled information from the "Template" worksheet before being automatically populated with that country's pertinent information from the Data worksheet - (Data: B?:M?)

The first part in (2) is working smoothly however I messed up extracting data from column "B?" to "M?". It is taking "Algeria" data (B3:M3) and populating all the other countries with that data. I was hoping it would extract B4:M4 for Angola and populate Angola's worksheet with that information. Then it should work down the list using the next country with the relative range (B?:M?)

If this is not too much trouble I would appreciate any help you can render. I will continue to work with it but right now I can't seem to make any headway.
TrowaD 2391 Posts Sunday September 12, 2010Registration dateContributorStatus July 12, 2018 Last seen - Aug 20, 2013 at 10:51 AM
0
Thank you
Hi Ibtrini,

I'm guessing that the AFR sheet mentioned in the code is supposed to be Data sheet.
There you are always referring to row 3. You should refer to the row of MyCell.

It is also advisable to use "Application.CutCopyMode = False" when you use copy/paste on 2 lines, to clear Excel's memory.

Here is your code with the mentioned adjustments:
Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("Data").Range("A3")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange

    Sheets.Add After:=Sheets(Sheets.Count) ' worksheet creation
    Sheets(Sheets.Count).Name = MyCell.Value ' worksheet renaming
    
    Sheets("Template").Select
    Range("A1:M80").Select
    Selection.Copy
    Sheets(Sheets.Count).Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Columns("A:A").Select
    Range("A69").Activate
    Selection.ColumnWidth = 50.43
    Columns("B:M").Select
    Range("B81").Activate
    Selection.ColumnWidth = 2
    Cells.Select
    Range("A1:A80").Activate
    Selection.Rows.AutoFit
    
    Sheets("Data").Select
    Range(Cells(MyCell.Row, "B"), Cells(MyCell.Row, "M")).Select
    Selection.Copy
    Sheets(Sheets.Count).Select
    Range("N69").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

Next MyCell

Application.CutCopyMode = False
End Sub


The resizing has definitely to do with your cells being merged. Try unmerging then copy/paste and then merging again. Use macro recorder to get you started.

Best regards,
Trowa
ibtrini 7 Posts Saturday August 17, 2013Registration date September 5, 2013 Last seen - Aug 22, 2013 at 09:36 AM
0
Thank you
Obstacles can be a source of frustration however when coupled with persistence the learning process can be greatly enhanced. I already had the code to add the new worksheets from another worksheet but was experiencing two issues: (1) formatting the rows and columns in the newly created worksheets and (2) populating the newly created worksheets with selected data. Also, working with a copy of the production file was cumbersome so I created a smaller sample file based on their data and template worksheets - This made testing so much easier for me. I also came across a link which cleared up concepts I would need to solve my problem. Even though the quality of the video was not good at times, the content is really good for anyone seeking knowledge on the "Match" and "Indexing" functions. Here is the video link: http://www.youtube.com/watch?v=59c60PWsZjI

I know this post is huge however it may provide a clearer insight with the info below. I am sure there is another method to have it work more efficiently however it's this rookie's first jump into the macro and vba world.

Sub CreateSheetsFromAList()
` Create an array
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Data").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

' Loop through country range - Get Country name
For Each MyCell In MyRange

' Worksheet creation - Add new, blank worksheet
Sheets.Add After:=Sheets(Sheets.Count)

' Worksheet renaming - Rename to Country
Sheets(Sheets.Count).Name = MyCell.Value

' Select Range from "Template" to use with newly created worksheet
Sheets("Template").Select
Range("A1:M16").Select
Selection.Copy
Sheets(Sheets.Count).Select
Range("A1").Select

' The copy sequence here made a huge difference
' Copy layout from the source template (formatting cells)
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Copy static data from the source template
ActiveSheet.Paste

' Assign Country value to cell to be used in the "Match" function
Range("B1:B1") = MyCell.Value

` Populate newly created worksheet using string concatenation in the "Index" function
Range("B3:B3") = "=INDEX(Data!B2:J5,MATCH(" & MyCell.Value & "!B1,Data!A2:A5,0),MATCH(" & MyCell.Value & "!A3,Data!B1:J1,0))"
Range("B4:B4") = "=INDEX(Data!B2:J5,MATCH(" & MyCell.Value & "!B1,Data!A2:A5,0),MATCH(" & MyCell.Value & "!A4,Data!B1:J1,0))"
Range("B8:B8") = "=INDEX(Data!B2:J5,MATCH(" & MyCell.Value & "!B1,Data!A2:A5,0),MATCH(" & MyCell.Value & "!A8,Data!B1:J1,0))"
Range("B9:B9") = "=INDEX(Data!B2:J5,MATCH(" & MyCell.Value & "!B1,Data!A2:A5,0),MATCH(" & MyCell.Value & "!A9,Data!B1:J1,0))"
Range("B12:B12") = "=INDEX(Data!B2:J5,MATCH(" & MyCell.Value & "!B1,Data!A2:A5,0),MATCH(" & MyCell.Value & "!A12,Data!B1:J1,0))"
Range("B13:B13") = "=INDEX(Data!B2:J5,MATCH(" & MyCell.Value & "!B1,Data!A2:A5,0),MATCH(" & MyCell.Value & "!A13,Data!B1:J1,0))"
Range("B14:B14") = "=INDEX(Data!B2:J5,MATCH(" & MyCell.Value & "!B1,Data!A2:A5,0),MATCH(" & MyCell.Value & "!A14,Data!B1:J1,0))"
Range("B16:B16") = "=INDEX(Data!B2:J5,MATCH(" & MyCell.Value & "!B1,Data!A2:A5,0),MATCH(" & MyCell.Value & "!A16,Data!B1:J1,0))"

' Return to beginning of loop
Next MyCell

Application.CutCopyMode = False

End Sub

********************* Worksheet elements *********************
Template Layout (13 columns, 16 rows)
Country:

Population:
Population urban:

Consumption patterns
Recorded
Males:
Females:

Consumption pattern by Category
Beer consumption:
Wine consumption:
Spirits consumption:

Change:-

Data Layout (10 columns, 5 rows) - shown separated by colons
Country:Population:Population urban:Males:.Females:Income group:Change:Beer consumption:Wine consumption:Spirits consumption
Algeria:11,111,111:10:85%:15%:High income:+: 34%:56%:0%
Angola:22,222,222:20:65%:35%:Low income:-:54%:73%:11%
Benin:33,333,333:30:55%:45%:Upper-middle income:nc: 62%:93%:15%
Botswana: 44,444,444:40:45%:55%:Lower-middle income:-:34%:56%:93%

Result after running macro - 4 new worksheets by Country with its relative data in 13 columns and 16 rows
Country: Botswana

Population: 44,444,444
Population urban:40

Consumption patterns
Recorded
Males:45%
Females:55%

Consumption pattern by Category
Beer consumption:0.34
Wine consumption:0.56
Spirits consumption:0.93

Change:-