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
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.).
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 :).
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
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.
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
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 ?
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
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."
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.
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
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
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?
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
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
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
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
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)
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.
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
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.
- Posts
- 2598
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- March 10, 2020
401The 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
Code is working perfectly fine, thanks a lot :)
I'll get in touch with if some modification required.
Regards,
Shridhar
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
- Posts
- 2598
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- March 10, 2020
401Try 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