you can use the following macro:
Sub CopyData()
Dim LMainWB As String
Dim LNewWB As String
Dim LRow As Integer
Dim LContinue As Boolean
Dim LColAMaster As String
Dim LColATest As String
Dim LWBCount As Integer
Dim LMsg As String
Dim LPath As String
Dim LFilename As String
Dim LColAValue As String
'Path to save all new workbooks to
LPath = "C:\"
'Retrieve name of the workbook that contains the data
LMainWB = ActiveWorkbook.Name
'Initialize variables
LContinue = True
LRow = 2
LWBCount = 0
'Start comparing with cell A2
LColAMaster = "A2"
'Loop through all column A values until a blank cell is found
While LContinue = True
LRow = LRow + 1
LColATest = "A" & CStr(LRow)
'Found a blank cell, do not continue
If Len(Range(LColATest).Value) = 0 Then
LContinue = False
End If
'Value in column A
LColAValue = Range(LColAMaster).Value
'Found occurrence that did not match, copy data to new workbook
If LColAValue < Range(LColATest).Value Then
'Copy headings
Range("A1:D1").Select
Selection.Copy
'Add new workbook and paste headings into new workbook
Workbooks.Add
LNewWB = ActiveWorkbook.Name
ActiveSheet.Paste
Range("A1").Select
'Copy data from columns A - D
Windows(LMainWB).Activate
Range(LColAMaster & ":D" & CStr(LRow - 1)).Select
Selection.Copy
'Paste results
Windows(LNewWB).Activate
Range("A2").Select
ActiveSheet.Paste
Range("A1").Select
'Save (and overwrite, if necessary) workbook with name from
column A
'and then close workbook
LFilename = LPath & LColAValue & ".xls"
If Dir(LFilename) < "" Then Kill LFilename
ActiveWorkbook.SaveAs Filename:=LFilename
ActiveWorkbook.Close
'Go back to Main sheet and continue where left off
Windows(LMainWB).Activate
LColAMaster = "A" & CStr(LRow)
'Keep track of the number of workbooks that have been
created
LWBCount = LWBCount + 1
End If
Wend
Range("A1").Select
Application.CutCopyMode = False
LMsg = "Copy has completed. " & LWBCount & " new workbooks have
been created."
LMsg = LMsg & Chr(10) & "You can find them in the following
directory:" & Chr(10) & LPath
MsgBox LMsg
End Sub
*** Sent via Developersdex
http://www.developersdex.com ***