Macro which can create new excel with 4 sheets per different criteria

[jgopalk]

Hi there,

I need a macro which can able to create an excel with 3 sheets based on the following criteria.

[TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl67, width: 64"]Name[/TD]
[TD="class: xl67, width: 64"]Age[/TD]
[TD="class: xl67, width: 64"]Gender[/TD]
[TD="class: xl67, width: 64"]Salary[/TD]
[/TR]
[TR]
[TD="class: xl65"]Ram[/TD]
[TD="class: xl68"]25[/TD]
[TD="class: xl69"]M[/TD]
[TD="class: xl65, align: right"]10000[/TD]
[/TR]
[TR]
[TD="class: xl65"]Ganesh[/TD]
[TD="class: xl69"]23[/TD]
[TD="class: xl68"]M[/TD]
[TD="class: xl65, align: right"]2000[/TD]
[/TR]
[TR]
[TD="class: xl65"]Saleem[/TD]
[TD="class: xl69"]10[/TD]
[TD="class: xl69"]M[/TD]
[TD="class: xl65, align: right"]62300[/TD]
[/TR]
[TR]
[TD="class: xl65"]Antony[/TD]
[TD="class: xl68"]26[/TD]
[TD="class: xl71"]M[/TD]
[TD="class: xl65, align: right"]85000[/TD]
[/TR]
[TR]
[TD="class: xl66"]Jebestine[/TD]
[TD="class: xl70"]30[/TD]
[TD="class: xl70"]M[/TD]
[TD="class: xl66, align: right"]36900[/TD]
[/TR]
[TR]
[TD="class: xl66"]Sheela[/TD]
[TD="class: xl70"]26[/TD]
[TD="class: xl70"]F[/TD]
[TD="class: xl66, align: right"]45630[/TD]
[/TR]
[TR]
[TD="class: xl66"]Karen[/TD]
[TD="class: xl70"]96[/TD]
[TD="class: xl70"]F[/TD]
[TD="class: xl66, align: right"]25300[/TD]
[/TR]
[TR]
[TD="class: xl66"]Veni[/TD]
[TD="class: xl70"]31[/TD]
[TD="class: xl70"]F[/TD]
[TD="class: xl66, align: right"]63900[/TD]
[/TR]
</tbody>[/TABLE]

Here based on the above table, I require a single separate excel with 3 sheets named "Age", "Gender", "Salary". The sheet age must contains Column B red colored text info (the whole row). Gender must contains Column C red color text (the whole row). Salary sheet must contains which there is no color in Column B and C.

Examble.
Age Sheet:
[TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]Name[/TD]
[TD="class: xl67, width: 64"]Age[/TD]
[TD="class: xl67, width: 64"]Gender[/TD]
[TD="class: xl65, width: 64"]Salary[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Ganesh[/TD]
[TD="class: xl68, width: 64"]23[/TD]
[TD="class: xl67, width: 64"]M[/TD]
[TD="class: xl66, width: 64"]2000[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Antony[/TD]
[TD="class: xl68, width: 64"]26[/TD]
[TD="class: xl68, width: 64"]M[/TD]
[TD="class: xl66, width: 64"]85000[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Sheela[/TD]
[TD="class: xl68, width: 64"]26[/TD]
[TD="class: xl68, width: 64"]F[/TD]
[TD="class: xl66, width: 64"]45630[/TD]
[/TR]
</tbody>[/TABLE]

"Gender" Sheet:
[TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]Name[/TD]
[TD="class: xl67, width: 64"]Age[/TD]
[TD="class: xl67, width: 64"]Gender[/TD]
[TD="class: xl65, width: 64"]Salary[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Saleem[/TD]
[TD="class: xl67, width: 64"]10[/TD]
[TD="class: xl68, width: 64"]M[/TD]
[TD="class: xl66, width: 64"]62300[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Antony[/TD]
[TD="class: xl68, width: 64"]26[/TD]
[TD="class: xl68, width: 64"]M[/TD]
[TD="class: xl66, width: 64"]85000[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Sheela[/TD]
[TD="class: xl68, width: 64"]26[/TD]
[TD="class: xl68, width: 64"]F[/TD]
[TD="class: xl66, width: 64"]45630[/TD]
[/TR]
</tbody>[/TABLE]

"Salary" Sheet:
[TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]Name[/TD]
[TD="class: xl67, width: 64"]Age[/TD]
[TD="class: xl67, width: 64"]Gender[/TD]
[TD="class: xl65, width: 64"]Salary[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Ram[/TD]
[TD="class: xl67, width: 64"]25[/TD]
[TD="class: xl67, width: 64"]M[/TD]
[TD="class: xl66, width: 64"]10000[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Karen[/TD]
[TD="class: xl67, width: 64"]96[/TD]
[TD="class: xl67, width: 64"]F[/TD]
[TD="class: xl66, width: 64"]25300[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]Veni[/TD]
[TD="class: xl67, width: 64"]31[/TD]
[TD="class: xl67, width: 64"]F[/TD]
[TD="class: xl66, width: 64"]63900

[/TD]
[/TR]
</tbody>[/TABLE]


Hope I am clear in what am asking.

Kindly take it as challenge and do this. I tried in many ways, but i couldnt do it.

Thanks,
Gopal

 

[abhi1687]

you can use this:

Sub NewWorkbook()

Dim cel As Range
Workbooks.Add
With ActiveWorkbook
    .SaveAs ThisWorkbook.Path & "\NewWorkbook.xls"
    .Sheets(1).Name = "Age"
    .Sheets(1).Range("A1:D1") = Array("Name", "Age", "Gender", "Salary")
    .Sheets(2).Name = "Gender"
    Sheets(2).Range("A1:D1") = Array("Name", "Age", "Gender", "Salary")
    .Sheets(3).Name = "Salary"
    Sheets(3).Range("A1:D1") = Array("Name", "Age", "Gender", "Salary")
End With
With ThisWorkbook.Sheets("Sheet1")
    For Each cel In .Range(.Range("A2"), .Range("A2").End(xlDown))
        If cel.Offset(, 1).Font.Color = 255 Then cel.EntireRow.Copy ActiveWorkbook.Sheets("Age").Cells(ActiveWorkbook.Sheets("Age").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
        If cel.Offset(, 2).Font.Color = 255 Then cel.EntireRow.Copy ActiveWorkbook.Sheets("Gender").Cells(ActiveWorkbook.Sheets("Gender").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
        If cel.Offset(, 1).Font.Color <> 255 And cel.Offset(, 2).Font.Color <> 255 Then cel.EntireRow.Copy ActiveWorkbook.Sheets("Salary").Cells(ActiveWorkbook.Sheets("Salary").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
    Next
End With

End Sub

in below line change Sheet1 to the sheet name in which your data table is
With ThisWorkbook.Sheets("Sheet1")

 

[jgopalk]

First of all I am terribly sorry for this late reply. I couldn't access my internet due to some issue here. Anyway thank you so much for your reply.

When i save your query and run it, new workbook created with sheet 1 "age" and headers in A1 to D1 with error "Run-time error '9': Subscript out of range". When i click debug the error highlighted in yellow in the code ".Sheets(2).Name = "Gender"". I couldn't understand why this is happening.

Kindly let me know where i went wrong.

Thanks in advance for your time.

Best regards,
Gopal

 

[abhi1687]

Hi Gopal

you must be using excel 2013 or changed the excel options to create new workbook with 1 sheet only. anyways put this line

Application.SheetsInNewWorkbook = 3

before

Workbooks.Add

that should solve your problem

 

[jgopalk]

Its working.


Thank you so much Abhi.


Great work.


Gopal