On May 4, 2:37 pm, "Bernie Deitrick" <deitbe @ consumer dot org
wrote:
Ryan,

Bernie! You are amazing, That is exactly what I was trying to
accomplish! Lunch is on me if you are ever in Vegas!

What a small world.... I'm actually planning on attending the Kitchen and Bath Industry Show in
Vegas this Monday through Thursday - but I have a full schedule of meetings, breakfasts, lunches,
and dinners... Thanks for the offer, and thanks for letting me know that the code worked for you

Bernie
MS Excel MVP

Well have fun in Vegas, and just in case you wanted a bit more
trivia....
Instead of just creating a new sheet, I want to copy a template I have
for the data to be placed in, and use that. I was able to add a few
lines to delete the default Sheet1,Sheet2 etc, but I was unable to get
the copy template deal to work. I didn't ask before because I want to
be able to learn this stuff, and you can't learn it unless you have
some trial and error. Here is the current code I am working with,
and I want to use a template sheet called "TEMPLATE". Thanks again
for all your help Bernie!

Sub TryNow3()
Dim myName As String
Dim myCell As Range
Dim CellAdd1 As String
Dim CellAdd2 As String
Dim CellAdd3 As String
Dim myPath As String

myPath = "C:\Documents and Settings\r***" ' path changed

'CellAdd1 = "A16"
CellAdd2 = "A18"
CellAdd3 = "E18"

myName = ""

For Each myCell In Intersect(Range("A:A"), Selection)

If myCell.Value < "" Then
If myName < "" Then
ActiveWorkbook.SaveAs myName, xlNormal
ActiveWorkbook.Close False
End If
myName = myPath & myCell.Value & ".xls"
Workbooks.Add
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = myCell(1, 2).Value
'ActiveSheet.Range(CellAdd1).Value = myCell(1, 1).Value
ActiveSheet.Range(CellAdd2).Value = myCell(1, 2).Value
ActiveSheet.Range(CellAdd3).Value = myCell(1, 3).Value
Else
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = myCell(1, 2).Value
'ActiveSheet.Range(CellAdd1).Value = myCell(1, 1).Value
ActiveSheet.Range(CellAdd2).Value = myCell(1, 2).Value
ActiveSheet.Range(CellAdd3).Value = myCell(1, 3).Value
'Delete Unused Sheets
'Turn off run time errors and delete alert
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Worksheets("Sheet2").Delete
Worksheets("Sheet3").Delete
End If
Next myCell

ActiveWorkbook.SaveAs myName, xlNormal
ActiveWorkbook.Close False

End Sub