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 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 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
Related:

13 responses

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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
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..
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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