Any ideas on how to do this?
Hi,
Die_Another_Day
Many thanks for your code. I have not tried it yet because l was
working on my own code without using the filter technique. The code,
which does work, is pasted below. I created the list of unique criteria
using the advanced filter.
I have now been told that this is not a 'one-off' exercise so l will
try your code and use whichever is the most efficient.
Many, many thanks for all your help
Sub Test()
Dim tabname As String
Dim startrow As Integer
Dim endrow As Integer
Sheets("A&O List - Unique Prisons").Activate
Range("A2").Activate
For i = 1 To 138
tabname = ActiveCell.Value
Sheets.Add
ActiveSheet.Name = tabname
Sheets("Full A&O List").Range("A1:L1").Copy
Destination:=Sheets(tabname).Range("A1")
Sheets("Full A&O List").Activate
Range("A1").Activate
startrow = Cells.Find(What:=tabname, After:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
Range("A65536").Activate
endrow = Cells.Find(What:=tabname, After:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Row
Range("A" & startrow & ":L" & endrow).Copy
Destination:=Sheets(tabname).Range("A2")
Sheets("A&O List - Unique Prisons").Activate
ActiveCell.Offset(1, 0).Activate
Next i
End Sub
Reagrds,
Michael Beckinsale
|