How to create two or more excel workbook from one

[gamaz]

Hi,
I have a workbook which is called test.xls.

The following is the content of the test

ID custid amt
001 xxx 1000
001 yyy 2000
002 mmm 3000
002 ttt 500
002 nnn 2500

Now is there a way to loop through the above in excel and export the above data in two different workbook such that content of the first workbook is

ID custid amt
001 xxx 1000
001 yyy 2000

and the content of the second workbook will be
ID custid amt
002 mmm 3000
002 ttt 500
002 nnn 2500

The name of the first workbook will be 001.xls while the name of the second workbook will be 002.xls.
Thanks for any help.

[StephenR]

Yes, there is. Try this - you'll need to change the path.

Sub x()
 
Dim rng As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False

With Sheet1
    Sheets.Add().Name = "temp"
    Sheets.Add().Name = "temp2"
    .Range("A1", .Range("A1").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("temp").Range("A1"), Unique:=True
     For Each rng In Sheets("temp").Range("A2", Sheets("temp").Range("A2").End(xlDown))
        .AutoFilterMode = False
        .Range("A1").AutoFilter field:=1, Criteria1:=rng
        .AutoFilter.Range.Copy Sheets("temp2").Range("A1")
        Sheets("temp2").Copy
        ' change path
        ActiveWorkbook.Close SaveChanges:=True, Filename:="C:\VBA test\" & rng & ".xls"
        Sheets("temp2").UsedRange.Clear
    Next rng
    .AutoFilterMode = False
    Sheets("temp").Delete
    Sheets("temp2").Delete
End With
     
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

[gamaz]

Thank s StephenR. I will try this today.