Description: Sub aa()
Dim a As Integer, b As Integer, c As Integer, sh As Worksheet
For a = 2 To [g65536].End(3).Row
If Cells(a, 7) <> Cells(a- 1, 7) Then
b = a
End If
c = Range("g:g").Find(Cells(a, 7), , , , , xlPrevious).Row
Set sh = Sheets.Add(, Sheets(Sheets.Count))
sh.Name = Sheets("sheet1").Cells(a, 7).Value
With Sheets("Sheet1")
Sheets("Sheet1").Range(.Cells(b, 1), .Cells(c, 10)).Copy Destination:=sh.[a2]
Sheets("Sheet1").Range("a1:j1").Copy Destination:=sh.[a1]
a = c
End With
Sheets("Sheet1").Select
Next
End Sub
To Search:
File list (Check if you may need any files):
N sheets.xls
Download