Dean,

Give this a try.


Sub CreateWorkbooks()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim FilePath As String
Dim MyArray As Variant
Dim rng As Range
Dim i As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False

Set WbMain = ThisWorkbook

MyArray = Array("ops", "sales", "mark", "lnl", "fwp", "pbc", "rtd",
"wine")
Set rng = Range("dir")

For i = 0 To UBound(MyArray)
Set sh = WbMain.Worksheets(MyArray(i))
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
FilePath = Application.WorksheetFunction.VLookup(MyArray(i),
rng, 2, False)
Wb.SaveAs FilePath
Wb.Close False
End If
Next i

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub



--
Hope that helps.

Vergel Adriano


" wrote:

Hi,
The code below is to create a workbook for each of the sheets in the
array and then save each workbook and save into its specific directory
which is stored in a range. I attempted to use the Lookup function
but it is giving me a type mismatch error. Please advise. Cheers-
Dean

Range named "dir"

Group Directory
ops "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\ops.xls"
sales "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\sales.xls"
mark "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\mark.xls"
lnl "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\lnl.xls"
fwp "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\fwp.xls"
pbc "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\pbc.xls"
rtd "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\rtd.xls"
wine "C:\Documents and Settings\dbrunne\My Documents\Overheads\Test
\wine.xls"

CODE

Sub CreateWorkbooks()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim FilePath As String
Dim MyArray As Variant
Dim rng As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

Set WbMain = ThisWorkbook

MyArray = Array("ops", "sales", "mark", "lnl", "fwp", "pbc",
"rtd", "wine")
Set rng = Range("dir")

For Each sh In WbMain.Worksheets(MyArray)
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
FilePath = Application.WorksheetFunction.Lookup(MyArray,
rng)
Wb.SaveAs FilePath
Wb.Close False
End If
Next sh


Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub