Excel - A macro to create new workbook and copy data

Solved/Closed
Shridharb2002
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
- Sep 21, 2013 at 02:30 AM
TrowaD
Posts
2886
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
June 27, 2022
- Apr 18, 2017 at 11:21 AM
In the example below, I want to copy Column A starting from row 2 ie: "Age" till the value available ie: "Code and column B starting from row 2 ie: "27" till the value available ie: "0001" and paste in a new sheet and save with the name as in the cell B2 ie: "Shridhar1". same should be repeated for column C then column D till the value available.

Name Shridhar1 Shridhar2 Shridhar5 Shridhar7
Age 27 29 50 72
Add Juhu Andheri Khar Bandra
Code 0001 0050 5000 1200

Thanks in Advance

13 replies

TrowaD
Posts
2886
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
June 27, 2022
515
Updated on Nov 30, 2018 at 09:33 AM
Hi Shridhar,

Please note that a sheet is not the same as a workbook as this will create confusion.
A workbook/excel file can contain multiple sheets/worksheets and not the other way around.

That being said here is your code:
Sub RunMe()
Dim lRow, lCol As Integer

Sheets("Master").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column

For Each cell In Range(Cells(1, "B"), Cells(1, lCol))
    Union(Range("A1:A" & lRow), Range(Cells(1, cell.Column), Cells(lRow, cell.Column))).Copy
    Workbooks.Add
    Range("A1").PasteSpecial
    ActiveWorkbook.SaveAs Filename:= _
    "C:\YourMap\" & cell.Value & ".xls" 'You might want to change the extension (.xls) according to your excel version
    ActiveWorkbook.Close
Next cell

Application.CutCopyMode = False
End Sub

Just watch the file extension within the code (look for green text after pasting.).

Best regards,
Trowa
8
Shridharb2002
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014

Dec 2, 2013 at 07:13 AM
Thanks Trowa,

The code is working perfect, can you also help me if I want the output without 1st row means without name as the workbook is named with the name.

and is it possible if we can get the output in a particular format like column width and height and font..

Please let me if it is possible..
0
TrowaD
Posts
2886
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
June 27, 2022
515
Dec 3, 2013 at 11:38 AM
That is definitely possible Shridhar.

The following code doesn't copy the first row and has 4 extra lines to change Row Height, Column Width, Font and Font Size.
In the code I used column A as example. You could repeat the lines for other columns or apply the changes to multiple columns as in Columns("A:C") [or Rows("1:2") for Row Height]. The choice is yours :).

Here is the code:
Sub RunMe()
Dim lRow, lCol As Integer

Sheets("Master").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column

For Each cell In Range(Cells(1, "B"), Cells(1, lCol))
Union(Range("A2:A" & lRow), Range(Cells(2, cell.Column), Cells(lRow, cell.Column))).Copy
Workbooks.Add
Range("A1").PasteSpecial

Rows("1:1").RowHeight = 20
Columns("A:A").ColumnWidth = 10
Columns("A:A").Font.Name = "Arial Narrow"
Columns("A:A").Font.Size = 20

ActiveWorkbook.SaveAs Filename:= _
"C:\YourMap\" & cell.Value & ".xls" 'You might want to change the extension (.xls) according to your excel version
ActiveWorkbook.Close
Next cell

Application.CutCopyMode = False
End Sub

Let me know if more changes are desired.

Best regards,
Trowa
0
Shridharb2002
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014

Dec 5, 2013 at 05:39 AM
Thanks Trowa,
Code is working perfectly fine, thanks a lot :)
I'll get in touch with if some modification required.

Regards,
Shridhar
0
Shridharb2002
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014

Jan 7, 2014 at 08:01 AM
Hi Trowa,

Need your help for another macro,

I have a sheet which has, "A" column with City and B with Names and C, D, E.. with some other information. Now column A has duplicate value like India for more than 2 rows and all other column with the respective values.

I need an output which will create number of unique sheets with all the respective columns.

Like if column A2, A5, A7, A10 consist of value as India, then a sheet should be created as india and all the information from A2, A5, A7, A10 should be pasted there.

Please help me with this.

Thanks & Regards,
Shridhar
0
TrowaD
Posts
2886
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
June 27, 2022
515
Jan 13, 2014 at 11:42 AM
Hi Shridhar,

Try this code and let me know how it works out:
Sub RunMe()
For Each cell In Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
cell.EntireRow.Copy
On Error GoTo CreateSheet
Sheets(cell.Value).Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Next cell

Application.CutCopyMode = False
Exit Sub

CreateSheet:
Worksheets.Add.Name = cell.Value
Resume

End Sub
Best regards,
Trowa
0