Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic new worksheet creation at each change of value in a first worksheet
Hi,
I have a worksheet with all my supplier invoices. In colum "A", I have the supplier name. In all other columns I have the details of the invoices. I want to have a macro that sort the sheet on column A, then automatically create a worksheet per supplier with all invoices. This mean at each change of supplier name, I want a new worksheet with the invoices of this supplier. I wonder if you could give me some hints ... Thanks a lot Benjamin |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic new worksheet creation at each change of value in a first worksheet
Thanks Michael
It worked ... I made it that way: Sub CreatePrisonSheets() Dim tabname As String Dim sheetname As String Dim startrow As Long Dim endrow As Long 'Dim records As Integer Sheets("File_Approval").Activate ActiveSheet.Range("A1").EntireColumn.Insert Range("B1:B65356").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True iLastRow = Cells(Rows.Count, "A").End(xlUp).Row ActiveSheet.Range("L1") = iLastRow Application.ScreenUpdating = False Sheets("File_Approval").Activate Range("A2").Activate For i = 1 To (iLastRow - 1) ' Amend to find the lastrow tabname = ActiveCell.Value 'MsgBox (ActiveCell.Value) Sheets.Add sheetname = Left(tabname, 30) ActiveSheet.Name = sheetname Sheets("File_Approval").Range("B1:P1").Copy Destination:=Sheets(sheetname).Range("A1") Sheets("File_Approval").Activate Range("B1").Activate startrow = Cells.Find(What:=tabname, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row Range("B65536").Activate endrow = Cells.Find(What:=tabname, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row Range("B" & startrow & ":P" & endrow).Copy Destination:=Sheets(sheetname).Range("A2") 'Sheets("Full A&O List").Activate a = 2 + i 'MsgBox (a) Worksheets("File_Approval").Range("A" & a).Activate 'MsgBox (ActiveCell.Value) 'ActiveCell.Offset(1, 0).Activate Application.CutCopyMode = False Next i End Sub michael.beckinsale schreef: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Automatic Worksheet Calculation when Worksheet Name Changes | Excel Worksheet Functions | |||
need help with creation of an investment analysis worksheet | New Users to Excel | |||
Action Item Worksheet Creation | Excel Worksheet Functions | |||
Automatic updating of a rollup worksheet when a new worksheet is a | Excel Worksheet Functions | |||
Using this Automatic Resizing Macro with Worksheet Change | Excel Discussion (Misc queries) |