Solved: save user selected sheets into new workbook

[crush]

I'm trying to find a way to save certain worksheets from an open workbook as a new workbook. I have a user form with serveral checkboxes. Each check box represents a particular worksheet. Currently there are 4 options. The idea is to allow the user to select which data (sheet) to export ready for importing into a new file.

i'm not sure how to take the user options and store them in an array to create the new workbook, can any one help?

i have a prototype attached... currently the worksheet array is hardcoded, how can I make it dynamic based on the user options as shown in the export form.

[geekgirlau]

I've made a modication here - I've used a list box instead of the checkboxes, and had it populated automatically with a list of all of the sheets.

[jammer6_9]

Perfect, it's what I need as well. I have added additional option upon clicking export, SaveAs Dialog pops up and let the user enter the new file name of the workbook and save it in desired location;

[vba]
Sub ExportData()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~
' Exports the nominated sheets
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~
Dim strSheet() As String
Dim strNewWB As String
Dim intWS As Integer
Dim i As Integer
Dim sFile As Variant


' Sheets(Array("Activity Data", "Factory Data", "Staff & Admin Data", "Currency Data", "Cost by Currency Report Data")).Copy

strNewWB = ActiveWorkbook.Path & "\Export.xls"

' which sheets were selected?
For i = 0 To frmExportData.lstSheet.ListCount - 1
If frmExportData.lstSheet.Selected(i) = True Then
' capture the department name in array
ReDim Preserve strSheet(0 To intWS) As String
strSheet(intWS) = frmExportData.lstSheet.List(i)

intWS = intWS + 1
End If
Next i

' were any sheets selected?
If UBound(strSheet) = frmExportData.lstSheet.ListCount - 1 Then
MsgBox "Please select one or more sheets for export", vbInformation, _
"No Selection Made"
Else
Sheets(strSheet()).Copy

' create export file
'ActiveWorkbook.SaveAs strNewWB
Unload frmExportData

'Allow user to show SaveAs Dialog Box
sFile = Application.GetSaveAsFilename(InitialFileName:="Exported Report", _
fileFilter:="Microsoft Office Excel Workbook (*.xls), *.xls", Title:="Save workbook to..")

If sFile <> False Then
ActiveWorkbook.SaveAs Filename:=sFile
End If
End If
End Sub

[/vba]

I've made a modication here - I've used a list box instead of the checkboxes, and had it populated automatically with a list of all of the sheets.

[crush]

geekgirlau - thanks for your feedback and ideas they were just what i needed - i learned from what you did and managed to get the same form working with the checkboxes

p.s. how do i mark this as solved?

[Bob Phillips]

At the top of the page, there is a 'Thread Tools' option. It is in there.

[geekgirlau]

Crush, your method works, however if you make a change to any of the sheets for export (or want additional sheets) you will need to modify your code. The example I sent will cope with these situations automatically.

[crush]

[FONT='Verdana','sans-serif']Understood, in my actual workbook I have many more worksheets and only 5 will be available for export; the other 10 or more sheets will not be available. So whether I use a list box or checkboxes, if I have to include a new sheet for export I would need to modify my code to accommodate. I prefer checkboxes in this instance as an interface for export. Thanks once again for your ideas they really helped me out [/FONT]
[FONT='Verdana','sans-serif'] [/FONT]
[FONT='Verdana','sans-serif']Kindest regards[/FONT]
[FONT='Verdana','sans-serif']CRush [/FONT]

[anandbohra]

hello to all

while searching in Chip pearson site I got the dynamic solution for your query
but the problem in i am not able to handle multiple selection (trying for that)
hope other genius can solve this in a minute.

reference taken from

http://www.cpearson.com/excel/ListBoxUtils.htm

[Bob Phillips]

Seems overly-complex to me, but this will handle the multiples

[vba]


Public Sub test_msg()
Dim S() As String
Dim FirstIndex As Long
Dim LastIndex As Long
Dim SelCount As Long
Dim Ndx As Long
Dim WB As Workbook
Dim sh
Dim SheetName As String
Dim finalsheet As String
Dim arySheets

LBXSelectionInfo LBX:=frmExportData.ListBox1, SelectedCount:=SelCount, _
FirstSelectedItemIndex:=FirstIndex, LastSelectedItemIndex:=LastIndex
If SelCount > 0 Then
ReDim arySheets(1 To SelCount)

S = LBXSelectedItems(LBX:=frmExportData.ListBox1)
For Ndx = LBound(S) To UBound(S)
arySheets(Ndx + 1) = S(Ndx)
Next Ndx
'MsgBox MsgText, vbOKOnly, "Selected Items"
finalsheet = Left(MsgText, Len(MsgText) - 2)
Sheets(arySheets).Copy
Set WB = ActiveWorkbook
WB.SaveAs ThisWorkbook.Path & "\anandExport.xls"
WB.Close

End If

End Sub
[/vba]

[anandbohra]

Thanks XLD
it works just have to delete this line
finalsheet = Left(MsgText, Len(MsgText) - 2)

[Bob Phillips]

Yeah, it doesn't hurt, but it is unnecessary.