Data from One Worksheet split into Multiple Worksheets

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

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?
 
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)




DougJoe said:
I have a remittance file data in columns in one worksheet. The data is for multiple vendors some with more than one invoice.
Click to expand...
An example of the data follows:
 
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
 
Back
Top