Report

Excel - A macro to create new workbook and copy data [Solved/Closed]

Ask a question Shridharb2002 14Posts Saturday September 21, 2013Registration date April 9, 2014 Last seen - Last answered on Apr 18, 2017 at 11:21 AM by TrowaD
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
Helpful
+4
plus moins
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
Was this answer helpful?  
TrowaD 2286Posts Sunday September 12, 2010Registration date ContributorStatus November 7, 2017 Last seen - 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
Shridharb2002 14Posts Saturday September 21, 2013Registration date April 9, 2014 Last seen - 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
Shridharb2002 14Posts Saturday September 21, 2013Registration date April 9, 2014 Last seen - 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
TrowaD 2286Posts Sunday September 12, 2010Registration date ContributorStatus November 7, 2017 Last seen - 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
Hamawii- Sep 12, 2015 at 12:05 AM
Dear TrowaD,

I Tried using this code but in the line of " Sheets("Master").Select "
It gives me error,
Moreover I want to use this code to copy the old sheet then Generate a new one but with different data Value entries, So can it be done because I Have trying it for a couple of days and its not working ?

Best Regards,
Hamawii
Helpful
+2
plus moins
Hi guys,

I took the liberty to call the sheet with data the Master sheet.

Try out this 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
Sheets.Add
ActiveSheet.Name = cell.Value
Range("A1").PasteSpecial
Sheets("Master").Select
Next cell

Application.CutCopyMode = False
End Sub

Best regards,
Trowa
Shridharb2002 14Posts Saturday September 21, 2013Registration date April 9, 2014 Last seen - Nov 26, 2013 at 02:08 AM
Hi Trowa,

Thanks for the code, this is working fine but the output is thrown in the same sheet, I need output in different sheets, like shridhar1 would be one workbook, shridhar2 would be another workbook.

Thanks in advance.

Regards,
Shridhar
Helpful
+2
plus moins
Hi Shridhar,

Still in good health, thanks for asking. Hopefully health is on your side as well.

If I understand you correctly, then you want to combine the Macro's as one.

Here you go:
Sub CountColors()
Dim RedColor As Integer
Dim RedCount As Long
Dim GreenColor As Integer
Dim GreenCount As Long
Dim BlueColor As Integer
Dim BlueCount As Long
Dim PurpleColor As Integer
Dim PurpleCount As Long
Dim OrangeColor As Integer
Dim OrangeCount As Long

Application.ScreenUpdating = False

RedColor = 3
GreenColor = 43
BlueColor = 23
PurpleColor = 47
OrangeColor = 44

For Each cell In Selection
If cell.Interior.ColorIndex = RedColor Then RedCount = RedCount + 1
If cell.Interior.ColorIndex = GreenColor Then GreenCount = GreenCount + 1
If cell.Interior.ColorIndex = BlueColor Then BlueCount = BlueCount + 1
If cell.Interior.ColorIndex = PurpleColor Then PurpleCount = PurpleCount + 1
If cell.Interior.ColorIndex = OrangeColor Then OrangeCount = OrangeCount + 1
Next cell

MsgBox "There are " & RedCount & " Red colored cells." & Chr(10) & _
"There are " & GreenCount & " Green colored cells." & Chr(10) & _
"There are " & BlueCount & " Blue colored cells." & Chr(10) & _
"There are " & PurpleCount & " Purple colored cells." & Chr(10) & _
"There are " & OrangeCount & " Orange colored cells."

Application.ScreenUpdating = True
End Sub

Best regards,
Trowa
Helpful
+1
plus moins
Hi Shridharb,

So sheet Sridhar1 should contain:
Name	Shridhar1
Age 27
Add Juhu
Code 1
Sheet Shridhar2 should contain:
Name	Shridhar2
Age 29
Add Andheri
Code 50
Sheet Shridhar5 should contain:
Name	Shridhar5
Age 50
Add Khar
Code 5000

Correct?

Best regards,
Trowa
chanti- Sep 23, 2013 at 12:05 PM
yes trowa..
Shridhar- Sep 23, 2013 at 03:50 PM
Please help me Trowa
Helpful
+1
plus moins
Hi Trowa,

The code you provided needs only one change instead of Msgbox I need the data to be printed in new workbook. any column and with any name.

Thanks & Regards,
Shridhar
TrowaD 2286Posts Sunday September 12, 2010Registration date ModeratorStatus November 7, 2017 Last seen - Apr 1, 2014 at 12:21 PM
Hi Shridhar,

This is what I did:
Created 2 workbooks.
1 being Source and 1 being Destination.

Source has headers in A1:D1.
Destination has headers in B1:E1 (same as source) and in A2:A6 (the colors)

When you run the code below from a module in Source book, the code will check if destination book is open. If not then book is opened and the counted colors are entered.

To make things work, make sure you create and save your destination book with the same setup as me (meaning Headers in same place).
Look for the green text in the code. There are 3 of them. 1 to change Source name, 1 to change Destination name and 1 for the full path of the destination book (for when it's closed).

NOTE: only the first 4 columns of the source book will be checked as per your instruction.

NOTE 2: code will loop through ALL cells of 4 columns. That will take some time. If you think it takes to long the look for the following line in the code:
For Each cell In Range(Cells(1, ColNr), Cells(Rows.Count, ColNr))
Now change Rows.Count into the number of rows you want to check (If you only colored the first 100 rows then replace with 100).

Here is the code:
Sub CountColors()
Dim RedColor, GreenColor, BlueColor, PurpleColor, OrangeColor, ColNr As Integer
Dim RedCount, GreenCount, BlueCount, PurpleCount, OrangeCount As Long

Application.ScreenUpdating = False

RedColor = 3
GreenColor = 43
BlueColor = 23
PurpleColor = 47
OrangeColor = 44

Do
ColNr = ColNr + 1
Workbooks("Source.xls").Activate 'Change filename
For Each cell In Range(Cells(1, ColNr), Cells(Rows.Count, ColNr))
If cell.Interior.ColorIndex = RedColor Then RedCount = RedCount + 1
If cell.Interior.ColorIndex = GreenColor Then GreenCount = GreenCount + 1
If cell.Interior.ColorIndex = BlueColor Then BlueCount = BlueCount + 1
If cell.Interior.ColorIndex = PurpleColor Then PurpleCount = PurpleCount + 1
If cell.Interior.ColorIndex = OrangeColor Then OrangeCount = OrangeCount + 1
Next cell

On Error GoTo OpenBook
Workbooks("Destination").Activate 'Change filename
Cont:
Cells(2, ColNr + 1) = RedCount
Cells(3, ColNr + 1) = GreenCount
Cells(4, ColNr + 1) = BlueCount
Cells(5, ColNr + 1) = PurpleCount
Cells(6, ColNr + 1) = OrangeCount

RedCount = 0
GreenCount = 0
BlueCount = 0
PurpleCount = 0
OrangeCount = 0

Loop Until ColNr = 4

Application.ScreenUpdating = True

Exit Sub
OpenBook:
'Change path to match yours
Workbooks.Open "C:\MyDocuments\Destination.xls"
GoTo Cont
End Sub

Best regards,
Trowa
Helpful
+0
plus moins
Hi Trowa,

How are you?
Hope you are doing good.

Regards,
Shridhar
Helpful
+0
plus moins
Hi Trowa,


I have the below macro which show me the count of different color in the sheet but one at a time as message box.

I want a code which will give me the count of all different color in a new excel as a report but only from selected column.

Please help me with this.

Thanks & Regards,
Shridhar

Sub MyColorRed()

Application.ScreenUpdating = False

Dim MyColor As Long
Dim MyCount As Long

MyColor = 3

Dim cell As Range
For Each cell In Selection
If cell.Interior.ColorIndex = MyColor Then MyCount = MyCount + 1
Next cell

MsgBox "There are " & MyCount & " cells that are this color"

Application.ScreenUpdating = True

End Sub
Sub MyColorGreen()

Application.ScreenUpdating = False

Dim MyColor As Long
Dim MyCount As Long

MyColor = 43

Dim cell As Range
For Each cell In Selection
If cell.Interior.ColorIndex = MyColor Then MyCount = MyCount + 1
Next cell

MsgBox "There are " & MyCount & " cells that are this color"

Application.ScreenUpdating = True

End Sub
Sub MyColorBlue()

Application.ScreenUpdating = False

Dim MyColor As Long
Dim MyCount As Long

MyColor = 23

Dim cell As Range
For Each cell In Selection
If cell.Interior.ColorIndex = MyColor Then MyCount = MyCount + 1
Next cell

MsgBox "There are " & MyCount & " cells that are this color"

Application.ScreenUpdating = True

End Sub
Sub MyColorPurple()

Application.ScreenUpdating = False

Dim MyColor As Long
Dim MyCount As Long

MyColor = 47

Dim cell As Range
For Each cell In Selection
If cell.Interior.ColorIndex = MyColor Then MyCount = MyCount + 1
Next cell

MsgBox "There are " & MyCount & " cells that are this color"

Application.ScreenUpdating = True

End Sub
Sub MyColorOrange()

Application.ScreenUpdating = False

Dim MyColor As Long
Dim MyCount As Long

MyColor = 44

Dim cell As Range
For Each cell In Selection
If cell.Interior.ColorIndex = MyColor Then MyCount = MyCount + 1
Next cell

MsgBox "There are " & MyCount & " cells that are this color"

Application.ScreenUpdating = True

End Sub
Helpful
+0
plus moins
Hi Trowa,

Thanks for your reply, yes I m fit and fine.

Instead of massage box I want the output in different workbook which will be saved with a particular name format.

Regards,
Shridhar
TrowaD 2286Posts Sunday September 12, 2010Registration date ModeratorStatus November 7, 2017 Last seen - Mar 31, 2014 at 12:16 PM
So you already created and formatted a new workbook for that.

Any specific location in mind ( as in which sheet, which cell)?

Paste entire sentence in a cell or spread across multiple cells?
Paste all 5 sentences in a cell or spread across multiple rows?

Do you want to overwrite old color report when new report is created?
or place new below old (or vice versa)?
or place new next to old (or vice versa)?

Do you want to loop through all columns with data in the 1st row (or whatever row, to know which columns are being used. Could be fixed numbers of columns as well), to create all color reports at once?

Do you want to loop through sheets as well?

Let me know.

Best regards,
Trowa
Helpful
+0
plus moins
Hi Trowa,

I have a sheet were 3 to 4 columns are filled with n number of rows and every column has a header like Name, Address etc. so possibly I will be highlighting some names with red, some with green and so on. and in the other column i:e Address I may highlight some other rows with all other colours. now I want a report in a new workbook which will give me a count as Name as header and color in one cell and its value in other cell for all the colors that I have mentioned above.

Probably you can mention the column header in the first row and colors and values below in the second to fifth row in A and B, second header in column D1 and color and value in D2 and E2, D3 and E3 and so on.

File can be saved with any name and any where on desktop or C:F

Thanks & Regards,
Shridhar
Helpful
+0
plus moins
Hi Trowa,

This code is working fine, I want few modifications in this ex:
column selection should be manual like if I want to select column A, D, G & M or column B, C, F, I any four columns that I want to select the macro should run on those columns.

One more thing I want this macro to run on all the sheets present in the workbook and not only on one sheet.

Please help me with this.

Thanks & Regards,
Shridhar
Helpful
+0
plus moins
Hi Trowa,

Please help..

Thanks & Regards,
Shridhar
TrowaD 2286Posts Sunday September 12, 2010Registration date ModeratorStatus November 7, 2017 Last seen - Apr 7, 2014 at 11:40 AM
Hi Shridhar,

Sorry to let you wait, but here is the requested code.

After running the code, excel will fire four input boxes your way that will let you enter your column letters. You can enter the column letters in any order you like (Meaning alphabetical order isn't necessary).

The code will also loop through each sheet in the source workbook.

Here is the code:
Sub CountColors()
Dim RedColor, GreenColor, BlueColor, PurpleColor, OrangeColor, x, y As Integer
Dim RedCount, GreenCount, BlueCount, PurpleCount, OrangeCount As Long
Dim myCol, myCol1, myCol2, myCol3, myCol4 As String
Dim ws As Worksheet

Application.ScreenUpdating = False

RedColor = 3
GreenColor = 43
BlueColor = 23
PurpleColor = 47
OrangeColor = 44

myCol1 = InputBox("Enter column letter of the first column to count colors:", "Input column letter")
myCol2 = InputBox("Enter column letter of the second column to count colors:", "Input column letter")
myCol3 = InputBox("Enter column letter of the third column to count colors:", "Input column letter")
myCol4 = InputBox("Enter column letter of the fourth column to count colors:", "Input column letter")

x = 1

Do
Workbooks("Source.xls").Activate 'Change filename
y = y + 1
If y = 1 Then myCol = myCol1
If y = 2 Then myCol = myCol2
If y = 3 Then myCol = myCol3
If y = 4 Then myCol = myCol4

For Each ws In Worksheets
For Each cell In Range(Cells(1, myCol), Cells(20, myCol))
If cell.Interior.ColorIndex = RedColor Then RedCount = RedCount + 1
If cell.Interior.ColorIndex = GreenColor Then GreenCount = GreenCount + 1
If cell.Interior.ColorIndex = BlueColor Then BlueCount = BlueCount + 1
If cell.Interior.ColorIndex = PurpleColor Then PurpleCount = PurpleCount + 1
If cell.Interior.ColorIndex = OrangeColor Then OrangeCount = OrangeCount + 1
Next cell
Next ws

On Error GoTo OpenBook
Workbooks("Destination.xls").Activate 'Change filename
Cont:
x = x + 1
Cells(2, x) = RedCount
Cells(3, x) = GreenCount
Cells(4, x) = BlueCount
Cells(5, x) = PurpleCount
Cells(6, x) = OrangeCount

RedCount = 0
GreenCount = 0
BlueCount = 0
PurpleCount = 0
OrangeCount = 0

Loop Until y = 4

Application.ScreenUpdating = True

Exit Sub
OpenBook:
'Change path to match yours
Workbooks.Open "C:\MyDocuments\Destination.xls"
GoTo Cont
End Sub

Best regards,
Trowa
Helpful
+0
plus moins
Hi Trowa,

Thank you for the code.. Here the code it not working properly
1) It is not counting in multiple sheets
2) The output it is showing is double of the number of colour I have selected. ex: if I have 3 cells in red colour the output is showing 6

Please help me with this.

Thanks & Regards,
Shridhar
TrowaD 2286Posts Sunday September 12, 2010Registration date ModeratorStatus November 7, 2017 Last seen - Apr 8, 2014 at 10:41 AM
Hi Shridhar,

You are absolutely right.
The code stayed on the same sheet and multiplied the counted colors by the number of sheets you have.

My test data was rather poor (3 sheets of the same setup).

To solve this, find the code line:
For Each ws In Worksheets

And place the following line below it:
ws.Activate

Best regards,
Trowa
Helpful
+0
plus moins
Hi Trowa,

Thanks a lot for your reply, but I already added ws.Select code and it worked.

Will ping you if I need any modification.

Thanks a Lot for you help

Take Care Trowa.

Regards,
Shridhar
Helpful
+0
plus moins
Hello,
I have another requirement to be performed using two excel sheets.

I am pulling a report from an SQL server DB, and I will get it into an excel sheet. From that excel, I need to copy all this data in a specific format, like a folder hierarchy depending upon a path that I need to input. Will this be possible in Excel macro using VB script?

Can some one help?

Thanks
Paul
TrowaD 2286Posts Sunday September 12, 2010Registration date ModeratorStatus November 7, 2017 Last seen - Oct 13, 2014 at 11:36 AM
Hi Paul,

Wouldn't it be more useful to keep your data in one workbook?

Which data would you like to copy where (cell references)?

Best regards,
Trowa
Helpful
+0
plus moins
Hi,

I am working on a macro script for my Master workbook to have a trigger button to auto-copy cell data to a new workbook and auto-save it with the cell data in the new workbook.
I have been referring to some sources but still unable to work out the script.

This is the data field I have:-



This will be new workbook data that I require to save as:-



The file name of the new workbook should be named using 2nd row cell data and in this form - "ACCOUNT_YYMMDD_A_DD.csv". (Note : the required format was .CSV format)

Much appreciated if someone could assist.

Thanks.
Brandon
Helpful
+0
plus moins
Hello,

The code is working well, thank you! But I want to be able to take a cell value and use that text for my filename. Is that possible? I am making a user friendly spreadsheet and I just want them to enter in excel what they want for the file name, I set up a button that works, so they click it and get a new spreadsheet with the name they chose.

Thank you!
Shelb
TrowaD 2286Posts Sunday September 12, 2010Registration date ModeratorStatus November 7, 2017 Last seen - Aug 11, 2016 at 11:49 AM
Hi Shelb,

How about asking the user for the sheet name like:
Sub RunMe()
Dim SheetName As String

SheetName = InputBox("Please enter sheet name:", "Creating a new sheet")
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = SheetName

End Sub


Best regards,
Trowa
fenrirwolf_gio- Apr 11, 2017 at 07:53 AM
Good day,

I understand this thread is already closed, but I'm just curios if it would be possible to have a full copy of the whole sheet, into a new XLS file.

Let's say from column "A" until the last column, the same as for the rows.
Can you guys help me with a code like this one?

Thanks and much appreciated.
-Giomar
Reply
TrowaD 2286Posts Sunday September 12, 2010Registration date ModeratorStatus November 7, 2017 Last seen - Apr 18, 2017 at 11:21 AM
Hi Giomar,

When you right-click your sheets tab, there is an option to move or copy the entire sheet. Selecting that, will give you the option to select the workbook and after which sheet you would like to move or copy the sheet to.

Best regards,
Trowa
Reply

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!