Automatic new worksheet creation at each change of value in a first worksheet
Hi Benjamin,
I wrote this code the other day and it does what you want. Use it as a
basis and amend to suit.
ie
1) "A&O List - Unique Prisons" should be the worksheet with your unique
list of suppliers
2) "Full A&O List" should be the worksheet with your list of invoices
3) Your list of invoices must be sorted so that each supplier /
customer is grouped together.
4) 138 should be amended to the number of unique suppliers. better
still use code to determine.
I created some 200 sheets in approx 5 seconds!
Sub CreatePrisonSheets()
Dim tabname As String
Dim startrow As Long
Dim endrow As Long
Application.ScreenUpdating = False
Sheets("A&O List - Unique Prisons").Activate
Range("A2").Activate
For i = 1 To 138 Amend to find the lastrow
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
Application.CutCopyMode = False
Next i
End Sub
Let me know how you get on
Regards
Michael Beckinsale
|