Macro Required....

K

kiran

Hi All,
I have a report as follows

Site Case ID+ Priority* Arrival Time Response Time Status* Case Type*
Pakistan AAHD00000376417 Medium 01/01/2009 12:45 01/01/2009
12:48 Closed Incident
Malaysia AAHD00000376584 Medium 02/01/2009 9:29 02/01/2009
9:32 WIP Incident
Indonesia AAHD00000376695 Low 02/01/2009 13:21 02/01/2009
14:08 Closed Request
India AAHD00000377262 Medium 05/01/2009 10:00 05/01/2009
10:03 Resolved Incident
Korea AAHD00000377363 Medium 05/01/2009 11:32 05/01/2009
12:19 Closed Question
India AAHD00000377630 Medium 05/01/2009 15:19 05/01/2009
15:20 Closed Incident
India AAHD00000377669 Medium 05/01/2009 16:34 05/01/2009
16:35 Resolved Incident
China AAHD00000377681 Medium 05/01/2009 17:25 05/01/2009
17:26 Closed Question
China AAHD00000378016 Medium 06/01/2009 9:54 06/01/2009
9:58 Closed Incident
Philippines AAHD00000378024 Medium 06/01/2009 10:01 06/01/2009
10:01 Closed Incident
Thailand AAHD00000378058 Medium 06/01/2009 10:30 06/01/2009
10:31 WIP Incident

I want country wise output in diffrent sheets
Out put should look as follows:-
Site CaseType Priority Status CaseID
India Incident Medium Closed AAHD00000377630
India Incident Medium Resolved AAHD00000377669

like wise I want in all the sheets for each country wise.

TIA
 
J

Joel

The code below assumes the orignal worksheet is c all Summary. change as
required.


Sub CreateSheets()

With Sheets("Summary")

Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("2:" & Lastrow).Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo

RowCount = 2
Start = RowCount
Do While .Range("A" & RowCount) <> ""
If .Range("A" & RowCount) <> .Range("A" & (RowCount + 1)) Then
'Create New sheet
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Country = .Range("A" & RowCount)
NewSht.Name = Country
'Make Header Row
.Range("A1") = "Site"
.Range("B1") = "CaseType"
.Range("C1") = "Priority"
.Range("D1") = "Status"
.Range("E1") = "CaseID"
'copy rows of data
.Range("A" & Start & ":A" & RowCount).Copy _
Destination:=NewSht.Range("A2")
.Range("G" & Start & ":G" & RowCount).Copy _
Destination:=NewSht.Range("B2")
.Range("C" & Start & ":C" & RowCount).Copy _
Destination:=NewSht.Range("C2")
.Range("F" & Start & ":F" & RowCount).Copy _
Destination:=NewSht.Range("D2")
.Range("B" & Start & ":B" & RowCount).Copy _
Destination:=NewSht.Range("E2")

NewSht.Columns("A:E").AutoFit

Start = RowCount + 1

End If

RowCount = RowCount + 1
Loop
End With
End Sub
 
J

Joel

The code below assumes the orignal worksheet is c all Summary. change as
required.


Sub CreateSheets()

With Sheets("Summary")

Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("2:" & Lastrow).Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo

RowCount = 2
Start = RowCount
Do While .Range("A" & RowCount) <> ""
If .Range("A" & RowCount) <> .Range("A" & (RowCount + 1)) Then
'Create New sheet
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Country = .Range("A" & RowCount)
NewSht.Name = Country
'Make Header Row
.Range("A1") = "Site"
.Range("B1") = "CaseType"
.Range("C1") = "Priority"
.Range("D1") = "Status"
.Range("E1") = "CaseID"
'copy rows of data
.Range("A" & Start & ":A" & RowCount).Copy _
Destination:=NewSht.Range("A2")
.Range("G" & Start & ":G" & RowCount).Copy _
Destination:=NewSht.Range("B2")
.Range("C" & Start & ":C" & RowCount).Copy _
Destination:=NewSht.Range("C2")
.Range("F" & Start & ":F" & RowCount).Copy _
Destination:=NewSht.Range("D2")
.Range("B" & Start & ":B" & RowCount).Copy _
Destination:=NewSht.Range("E2")

NewSht.Columns("A:E").AutoFit

Start = RowCount + 1

End If

RowCount = RowCount + 1
Loop
End With
End Sub
 
J

Joel

The code below assumes the orignal worksheet is c all Summary. change as
required.


Sub CreateSheets()

With Sheets("Summary")

Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("2:" & Lastrow).Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo

RowCount = 2
Start = RowCount
Do While .Range("A" & RowCount) <> ""
If .Range("A" & RowCount) <> .Range("A" & (RowCount + 1)) Then
'Create New sheet
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Country = .Range("A" & RowCount)
NewSht.Name = Country
'Make Header Row
.Range("A1") = "Site"
.Range("B1") = "CaseType"
.Range("C1") = "Priority"
.Range("D1") = "Status"
.Range("E1") = "CaseID"
'copy rows of data
.Range("A" & Start & ":A" & RowCount).Copy _
Destination:=NewSht.Range("A2")
.Range("G" & Start & ":G" & RowCount).Copy _
Destination:=NewSht.Range("B2")
.Range("C" & Start & ":C" & RowCount).Copy _
Destination:=NewSht.Range("C2")
.Range("F" & Start & ":F" & RowCount).Copy _
Destination:=NewSht.Range("D2")
.Range("B" & Start & ":B" & RowCount).Copy _
Destination:=NewSht.Range("E2")

NewSht.Columns("A:E").AutoFit

Start = RowCount + 1

End If

RowCount = RowCount + 1
Loop
End With
End Sub
 
J

Joel

The code below assumes the orignal worksheet is c all Summary. change as
required.


Sub CreateSheets()

With Sheets("Summary")

Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("2:" & Lastrow).Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo

RowCount = 2
Start = RowCount
Do While .Range("A" & RowCount) <> ""
If .Range("A" & RowCount) <> .Range("A" & (RowCount + 1)) Then
'Create New sheet
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Country = .Range("A" & RowCount)
NewSht.Name = Country
'Make Header Row
.Range("A1") = "Site"
.Range("B1") = "CaseType"
.Range("C1") = "Priority"
.Range("D1") = "Status"
.Range("E1") = "CaseID"
'copy rows of data
.Range("A" & Start & ":A" & RowCount).Copy _
Destination:=NewSht.Range("A2")
.Range("G" & Start & ":G" & RowCount).Copy _
Destination:=NewSht.Range("B2")
.Range("C" & Start & ":C" & RowCount).Copy _
Destination:=NewSht.Range("C2")
.Range("F" & Start & ":F" & RowCount).Copy _
Destination:=NewSht.Range("D2")
.Range("B" & Start & ":B" & RowCount).Copy _
Destination:=NewSht.Range("E2")

NewSht.Columns("A:E").AutoFit

Start = RowCount + 1

End If

RowCount = RowCount + 1
Loop
End With
End Sub
 
J

Joel

The code below assumes the orignal worksheet is c all Summary. change as
required.


Sub CreateSheets()

With Sheets("Summary")

Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("2:" & Lastrow).Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo

RowCount = 2
Start = RowCount
Do While .Range("A" & RowCount) <> ""
If .Range("A" & RowCount) <> .Range("A" & (RowCount + 1)) Then
'Create New sheet
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Country = .Range("A" & RowCount)
NewSht.Name = Country
'Make Header Row
.Range("A1") = "Site"
.Range("B1") = "CaseType"
.Range("C1") = "Priority"
.Range("D1") = "Status"
.Range("E1") = "CaseID"
'copy rows of data
.Range("A" & Start & ":A" & RowCount).Copy _
Destination:=NewSht.Range("A2")
.Range("G" & Start & ":G" & RowCount).Copy _
Destination:=NewSht.Range("B2")
.Range("C" & Start & ":C" & RowCount).Copy _
Destination:=NewSht.Range("C2")
.Range("F" & Start & ":F" & RowCount).Copy _
Destination:=NewSht.Range("D2")
.Range("B" & Start & ":B" & RowCount).Copy _
Destination:=NewSht.Range("E2")

NewSht.Columns("A:E").AutoFit

Start = RowCount + 1

End If

RowCount = RowCount + 1
Loop
End With
End Sub
 
J

Joel

The code below assumes the orignal worksheet is c all Summary. change as
required.


Sub CreateSheets()

With Sheets("Summary")

Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("2:" & Lastrow).Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo

RowCount = 2
Start = RowCount
Do While .Range("A" & RowCount) <> ""
If .Range("A" & RowCount) <> .Range("A" & (RowCount + 1)) Then
'Create New sheet
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Country = .Range("A" & RowCount)
NewSht.Name = Country
'Make Header Row
.Range("A1") = "Site"
.Range("B1") = "CaseType"
.Range("C1") = "Priority"
.Range("D1") = "Status"
.Range("E1") = "CaseID"
'copy rows of data
.Range("A" & Start & ":A" & RowCount).Copy _
Destination:=NewSht.Range("A2")
.Range("G" & Start & ":G" & RowCount).Copy _
Destination:=NewSht.Range("B2")
.Range("C" & Start & ":C" & RowCount).Copy _
Destination:=NewSht.Range("C2")
.Range("F" & Start & ":F" & RowCount).Copy _
Destination:=NewSht.Range("D2")
.Range("B" & Start & ":B" & RowCount).Copy _
Destination:=NewSht.Range("E2")

NewSht.Columns("A:E").AutoFit

Start = RowCount + 1

End If

RowCount = RowCount + 1
Loop
End With
End Sub
 
K

kiran

Thanks Joel


Joel said:
The code below assumes the orignal worksheet is c all Summary. change as
required.


Sub CreateSheets()

With Sheets("Summary")

Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("2:" & Lastrow).Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo

RowCount = 2
Start = RowCount
Do While .Range("A" & RowCount) <> ""
If .Range("A" & RowCount) <> .Range("A" & (RowCount + 1)) Then
'Create New sheet
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Country = .Range("A" & RowCount)
NewSht.Name = Country
'Make Header Row
.Range("A1") = "Site"
.Range("B1") = "CaseType"
.Range("C1") = "Priority"
.Range("D1") = "Status"
.Range("E1") = "CaseID"
'copy rows of data
.Range("A" & Start & ":A" & RowCount).Copy _
Destination:=NewSht.Range("A2")
.Range("G" & Start & ":G" & RowCount).Copy _
Destination:=NewSht.Range("B2")
.Range("C" & Start & ":C" & RowCount).Copy _
Destination:=NewSht.Range("C2")
.Range("F" & Start & ":F" & RowCount).Copy _
Destination:=NewSht.Range("D2")
.Range("B" & Start & ":B" & RowCount).Copy _
Destination:=NewSht.Range("E2")

NewSht.Columns("A:E").AutoFit

Start = RowCount + 1

End If

RowCount = RowCount + 1
Loop
End With
End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Find then highlight in yellow 6
Too negative XIRR? 3
Excel (or Access) Challenge 5
Autofil on variable rows, delete extract and show remaining rows 3
SUMIF Formula Help 8
Month Deduct Formula needed 4
Marco button, Copy and paste depending on criteria 0
Calculating occupational sick pay entitlement 0

Top