Check the attachment....
Code:
Option Explicit
Dim strFile As String
Dim wbk As Workbook
Sub GetFileAndSaveSheetToAnotherFileAndSaveAsValues()
Dim wks As Worksheet
strFile = Application.GetOpenFilename("Excel 1997-2010 Files (*.xls*), *.xls*")
If strFile <> "False" Then
Set wbk = Workbooks.Open(strFile, 0, 1)
strFile = ""
For Each wks In wbk.Worksheets
If wks.Visible Then
strFile = strFile & wks.Name & "|"
End If
Next wks
If strFile <> "" Then
strFile = Left(strFile, Len(strFile) - 1)
End If
frmSheetSelector.lstSheets.List = Split(strFile, "|")
frmSheetSelector.Show
End If
Set wks = Nothing
End Sub
Sub GetSheetDataToNewWorkbook(strSheetName As String)
Dim varArray
varArray = wbk.Sheets(strSheetName).UsedRange.Value
With Workbooks.Add(xlWorksheet)
.Sheets(1).Cells(1).Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray
.SaveAs Application.GetSaveAsFilename(FileFilter:="Excel 1997-2010 Files (*.xlsx), *.xlsx"), 51
.Close 0
End With
wbk.Close
Set wbk = Nothing
strFile = vbNullString
Unload frmSheetSelector
End Sub
Bookmarks