Menu
  1. Accueil
  2. Tech Forum
  3. Office Software
  4. Excel

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

Report
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
 -
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 -
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
See more
Related:

13 replies

Answer 1 / 13
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Thank you
8
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2831 users have said thank you to us this month

View all 6 comments
Report
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Report
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
Thanks Trowa,
Code is working perfectly fine, thanks a lot :)
I'll get in touch with if some modification required.

Regards,
Shridhar
Report
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
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
Report
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Report

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
Answer 2 / 13
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Answer 3 / 13
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Report

yes trowa..
Report

Please help me Trowa
Answer 4 / 13
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Report
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
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
Answer 5 / 13
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
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
Report
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Answer 6 / 13
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
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
Answer 7 / 13
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
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
Report
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Answer 8 / 13
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
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
Answer 9 / 13
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
Hi Trowa,

Please help..

Thanks & Regards,
Shridhar
Report
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Answer 10 / 13
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
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
Report
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Answer 11 / 13
Posts
12
Registration date
Saturday September 21, 2013
Status
Member
Last seen
April 9, 2014
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
Answer 12 / 13
Posts
1
Registration date
Tuesday August 25, 2015
Status
Member
Last seen
August 25, 2015
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
Answer 13 / 13

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
Report
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Report

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
Report
Posts
2644
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 31, 2020
 432
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
Ask a question