Saving selected worksheets in VBA

[singcbl]

The codes below allows me to save the active worksheet into a new workbook using the active worksheet tab name. My question is I like to save the selected sheets with a new name instead of just one sheet which the code below is doing.

Sub exportwksht()
    Dim myPath As String, NewName As String, ws As Worksheet
    myPath = ThisWorkbook.Path
    NewName = ActiveSheet.Name
    Application.DisplayAlerts = False
    For Each ws In Sheets
    On Error Resume Next
    If ws.Name <> NewName Then ws.Delete
    Next ws
    On Error GoTo 0
    Application.DisplayAlerts = True
    ThisWorkbook.SaveAs NewName & ".xls"
End Sub

 

[ravishankar]

Hi
try the following modifications

Sub exportwksht()
    Dim myPath As String, NewName As String, ws As Worksheet
    myPath = ThisWorkbook.Path
    NewName = ActiveSheet.Name
    Application.DisplayAlerts = False
  For a = 1 To Sheets.Count
  Cells(a, 1) = Worksheets(a).Name
  Cells(a, 2) = InputBox("enter new name for sheet " & Cells(a, 1) & " leave blank to delete")
  Next a
  For b = Sheets.Count To 1 Step -1
  If Cells(b, 2) = "" Then
  Worksheets(b).Delete
  Else
  Worksheets(b).Name = Cells(b, 2)
  End If
  Next b
    Application.DisplayAlerts = True
    ThisWorkbook.SaveAs NewName & ".xls"
End Sub

run the macro
It will ask for new name for old sheet name. if you return blank they will be deleted. rest of the sheets will be saved under activesheet name

 

[singcbl]

Ravishanker,

This error message appeared while running the codes. The macro stops at

Cells(a, 1) = Worksheets(a).Name

Runtime error '1004'
Application-defined or object -defined error

 

[singcbl]

Guys,

I hope there is an answer as to why the codes did not work as it suppose to.

 

[ravishankar]

Hi
I tested the codes again and they work as expected. retains renamed sheets and deletes ones without added names. Just give it a go again.
Ravi

 

[singcbl]

Ravi,

Do you think in my case it did not work because I have a few hidden sheets in this workbook which I need to retain as well.

 

[jindon]

try

Sub exportwksht()
    Dim myPath As String, NewName As String, ws As Worksheet
    Dim myList As STring, x
    myPath = ThisWorkbook.Path
    NewName = ActiveSheet.Name
    For Each ws In ActiveWindow.SelectedSheets
         myList = myList & ":" & ws.Name
    Next
    x = Split(Mid$(myList,2),":")
    Application.DisplayAlerts = False
    For Each ws In Sheets
         If IsError(Application.Match(ws.Name, x, 0)) Then ws.Delete
    Next
    Application.DisplayAlerts = True
    ThisWorkbook.SaveAs NewName & ".xls"
End Sub

 

[jindon]

try

Sub exportwksht()
    Dim myPath As String, NewName As String, ws As Worksheet
    Dim myList As STring, x
    myPath = ThisWorkbook.Path
    NewName = ActiveSheet.Name
    For Each ws In ActiveWindow.SelectedSheets
         myList = myList & ":" & ws.Name
    Next
    x = Split(Mid$(myList,2),":")
    Application.DisplayAlerts = False
    For Each ws In Sheets
         If IsError(Application.Match(ws.Name, x, 0)) Then ws.Delete
    Next
    Application.DisplayAlerts = True
    ThisWorkbook.SaveAs NewName & ".xls"
End Sub