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