Excel - A macro to create new workbook and copy data [Solved/Closed]
Shridharb2002
Moderator Last seen
December 18, 2018
- Apr 18, 2017 at 11:21 AM
- Posts
- 14
- Registration date
- Saturday September 21, 2013
- Last seen
- April 9, 2014
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
Related:
- Excel vba create new workbook and copy data
- Macro to create new sheet and copy data - Best answers
- Macro to create new workbook and copy data - Best answers
- Excel - Macro to create new workbook and copy data - How-To - Excel
- VBA Copy sheet to new Excel File + automated manual data entry ✓ - Forum - Excel
- Macro to Create New Workbook and Copy Data at Each Change of X - Forum - Excel
- Excel vba open another workbook and copy data - How-To - Excel
- Excel - A macro to create new workbook and copy data - How-To - Excel
13 replies
Best answer
approved by Jean-François Pillou
on Nov 30, 2018
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
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:
Just watch the file extension within the code (look for green text after pasting.).
Best regards,
Trowa
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
A few words of thanks would be greatly appreciated. Add comment
3567 users have said thank you to us this month
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
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:
Best regards,
Trowa
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
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
Hi guys,
I took the liberty to call the sheet with data the Master sheet.
Try out this code:
Best regards,
Trowa
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
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
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:
Best regards,
Trowa
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
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
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
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
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
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
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
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
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
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:
Best regards,
Trowa
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
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
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
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
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
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
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
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
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
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
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
Hi Shelb,
How about asking the user for the sheet name like:
Best regards,
Trowa
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
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
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
- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
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
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
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:
Let me know if more changes are desired.
Best regards,
Trowa
- Posts
- 14
- Registration date
- Saturday September 21, 2013
- Last seen
- April 9, 2014
-Code is working perfectly fine, thanks a lot :)
I'll get in touch with if some modification required.
Regards,
Shridhar
- Posts
- 14
- Registration date
- Saturday September 21, 2013
- Last seen
- April 9, 2014
-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
Try this code and let me know how it works out:
Best regards,
Trowa
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