Sub Copy_to_New_Workbook()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = True Then
ws.Activate
ActiveSheet.Copy
With ActiveWorkbook
.SaveAs "C:\Documents and Settings\All Users\Desktop\" & _
InputBox("Please enter the Save As Name...", "Worksheet Save As") & ".xls"
.Close
End With
End If
Next ws
End Sub