Michael,
Try this. Function routine is courtesy of Bob Phillips from a
previous posting.

Sub CopyToSheets()

Dim lastrow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Wks

Set ws1 = ThisWorkbook.Worksheets("MAIN")
ws1.Activate
With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To lastrow
If Not SheetExists(.Cells(r, 1)) Then
Set NewWS = Worksheets.Add
NewWS.Name = .Cells(r, 1)
End If
Set wks2 = Worksheets(.Cells(r, 1).Value)
nr = wks2.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws1.Cells(r, 1).Offset(0, 1).Resize(1, 2).Copy wks2.Range("a" & nr)
Next r
End With
End Sub
'-----------------------------------------------------------------
Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Function

"Michael Smith" wrote:

Thank you, thank you!..that works wonderfully....one last question that
I probably should have included in the original post, if the
worksheet(Name in column A) doesn't exist, how would i get it to create
a new worksheet with that name.
Thanks again, i was on the wrong track before your help.
-Mike



*** Sent via Developersdex http://www.developersdex.com ***