Dim myArr() As String
Dim wCtr As Long
Dim Ndx As Long
Dim fname As Variant
Dim strname As String
Dim strcheck As String

With Me.lstexport
wCtr = 0
ReDim myArr(1 To .ListCount)
For Ndx = 0 To .ListCount - 1
If .Selected(Ndx) = True Then
wCtr = wCtr + 1
myArr(wCtr) = .List(Ndx)
End If
Next Ndx
End With


If wCtr = 0 Then
'do nothing
Else
ReDim Preserve myArr(1 To wCtr)

Again:
fname = Application.GetSaveAsFilename("", fileFilter:="Excel
Files (*.xls), *.xls")

If fname = "False" Then
End
End If

If Dir(fname) < "" Then
MsgBox ("This filename is already taken. Please enter a
different filename.")
GoTo Again
End If

Worksheets(myArr).Copy
ActiveWorkbook.SaveAs Filename:=fname
Application.DisplayAlerts = True
End If

--------------------------------------------------------------------------
When I run this code, I get a 'subscript out of range' error on the
line

Worksheets(myArr).Copy

Can someone please tell me why?


--
kev_06
------------------------------------------------------------------------
kev_06's Profile: http://www.excelforum.com/member.php...o&userid=35046
View this thread: http://www.excelforum.com/showthread...hreadid=548744