I just left out one line to increment the row. I think your problem with the
dialog box appearing is caused because the code kereps on saving the same
file over and over again. The code assumes the filename is on Sheet2 column
a.

Sub SaveBooks()

'set sheets to copy
Set OldBk = ThisWorkbook

Set objShell = CreateObject("Shell.Application")
Set fs = CreateObject("Scripting.FileSystemObject")


On Error Resume Next
Set objFolder = objShell.BrowseForFolder(&H0&, "Select Folder ", &H4001&)

If objFolder Is Nothing Then
MsgBox ("Cannot open directory - Exiting Macro")
Exit Sub
End If
On Error GoTo 0

Set oFolderItem = objFolder.Items.Item
Folder = oFolderItem.Path
If Right(Folder, 1) < "\" Then
Folder = Folder & "\"
End If

With OldBk.Sheets("Sheet2")

RowCount = 2
Do While .Range("A" & RowCount) < ""

'get filename
FName = .Range("A" & RowCount)
'Create new workbook with one sheet, template sheet 1
OldBk.Sheets("Sheet1").Copy
Set NewBk = ActiveWorkbook
Set NewSht = NewBk.Sheets("Sheet1")
NewSht.Range("D5") = FName
'change formulas to cells
NewSht.Cells.Copy
NewSht.Cells.PasteSpecial _
Paste:=xlPasteValues

'Save new file
NewBk.SaveAs Filename:=Folder & FName
NewBk.Close savechanges:=False
RowCount = RowCount + 1
Loop
End With
End Sub





"Polo78 Lacoste" wrote:

Joel,
Thanks for the reply.... Awesome coding.. but I am having a problem with
the looping, it stays on the first record and when it tries to save the
file, as well as having a dialog prior to saving the first file, "Save
book2 with references to unsaved document?" Anyway to autosave it
without interaction? and fix the looping to move to the next row?

Thank you again.

Beginner in VBA.

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