Data from One Worksheet split into Multiple Worksheets
I have a remittance file data in columns in one worksheet. The data is for multiple vendors some with more than one invoice. An example of the data follows:
Vendor Invoice # Amount ABC Co 1234 $4,300 ABC Co 1235 $2,605 ABC Co 1236 $300 DEF Co 6543 $1,000,321 XYZ Co 123333 $10 XYZ Co 123334 $20 I need to split this data into separate worksheets in the same file so that ABC Co's info is in one spreadsheet, then DEF co's info is in the next etc. Can anyone tell me the Subroutine to make this happen? |
Data from One Worksheet split into Multiple Worksheets
Try this example on a test workbook
With the data in a sheet named "Sheet1" in the Range("A1:D20") ' change to yours It will make a unique list of column A in column G and also use H1:H2 in the macro. You can delete this two columns when your macro is ready Sub Test() Dim ws1 As Worksheet Dim wsNew As Worksheet Dim rng As Range Dim r As Integer Dim c As Range Set ws1 = Sheets("Sheet1") Set rng = ws1.Range("A1:D20") ws1.Columns("A:A").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Range("G1"), Unique:=True r = Cells(Rows.Count, "G").End(xlUp).Row Range("H1").Value = Range("G1").Value For Each c In Range("G2:G" & r) ws1.Range("H2").Value = c.Value Set wsNew = Sheets.Add wsNew.Name = ws1.Range("H2").Value rng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet1").Range("H1:H2"), _ CopyToRange:=wsNew.Range("A1"), _ Unique:=False Next End Sub -- Regards Ron de Bruin (Win XP Pro SP-1 XL2000-2003) www.rondebruin.nl "DougJoe" wrote in message ... I have a remittance file data in columns in one worksheet. The data is for multiple vendors some with more than one invoice. An example of the data follows: Vendor Invoice # Amount ABC Co 1234 $4,300 ABC Co 1235 $2,605 ABC Co 1236 $300 DEF Co 6543 $1,000,321 XYZ Co 123333 $10 XYZ Co 123334 $20 I need to split this data into separate worksheets in the same file so that ABC Co's info is in one spreadsheet, then DEF co's info is in the next etc. Can anyone tell me the Subroutine to make this happen? |
Data from One Worksheet split into Multiple Worksheets
This totally depends on the format of the worksheets, but assuming this
info starts on Row 1 Column 1 AND assuming the information is being moved to a worksheet with the same name as the company, With Worksheets(1) rowcount = .UsedRange.Row - 1 + .UsedRange.Rows.Count For x = rowcount To 1 Step -1 comp = .Cells(x, 1).Value cRow = Worksheets(comp).UsedRange.Row ..Rows(x).Cut Worksheets(comp).Rows(cRow).Insert Next x End With - Pikus --- Message posted from http://www.ExcelForum.com/ |
All times are GMT +1. The time now is 07:21 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com