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

myArr is a String array. Worksheets() expects an Integer argument.

kev_06 wrote:
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

That line expects that you're copying the worksheet name array from the
activeworkbook.

Is that where you loaded the list of worksheet names into the userform's
listbox?

I don't think using the End Statement is a good practice. I used something like
this and it worked ok:

Option Explicit
Private Sub CommandButton1_Click()

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 boolean 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 If
End Sub
Private Sub UserForm_Initialize()
Dim wks As Worksheet
Me.lstexport.MultiSelect = fmMultiSelectMulti
For Each wks In ActiveWorkbook.Worksheets
Me.lstexport.AddItem CStr(wks.Name)
Next wks
End Sub

=======
If you're picking up the worksheet names from a different workbook (non-active),
then make sure you use that same workbook to copy from:

Worksheets(myArr).Copy
would read more like:
Workbooks("book1.xls").Worksheets(myArr).Copy

As a personal choice, I used do/loop instead of goto.


kev_06 wrote:

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

--

Dave Peterson

Worksheets("Sheet1").select

works????

Mark Lincoln wrote:

myArr is a String array. Worksheets() expects an Integer argument.

kev_06 wrote:
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

--

Dave Peterson