K
kev_06
I still get a subscript out of range on the following line:
Worksheets(myArr).Copy
Any ideas?
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, nothing selected
Else
ReDim Preserve myArr(1 To wCtr)
Do
fname = Application.GetSaveAsFilename(""
fileFilter:="Excel Files (*.xls), *.xls")
'since fname is a variant, you can compare with the boolea
false
'not the string "False"
If fname = False Then
Exit Sub
End If
If Dir(fname) <> "" Then
MsgBox ("This filename is already taken." & vbLf
"Please enter a different filename.")
Else
Exit Do
End If
Loop
Worksheets(myArr).Copy
ActiveWorkbook.SaveAs Filename:=fname
End I
Worksheets(myArr).Copy
Any ideas?
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, nothing selected
Else
ReDim Preserve myArr(1 To wCtr)
Do
fname = Application.GetSaveAsFilename(""
fileFilter:="Excel Files (*.xls), *.xls")
'since fname is a variant, you can compare with the boolea
false
'not the string "False"
If fname = False Then
Exit Sub
End If
If Dir(fname) <> "" Then
MsgBox ("This filename is already taken." & vbLf
"Please enter a different filename.")
Else
Exit Do
End If
Loop
Worksheets(myArr).Copy
ActiveWorkbook.SaveAs Filename:=fname
End I