Move sheets and save work book

[Niranjanrajrishi]

Sub MoveSheets()
    Dim WB As Workbook, WS As Worksheet, SH As Worksheet
    Dim newwb As Workbook
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "Macro" Then
            If WB Is Nothing Then
                WS.Move
                Set WB = ActiveWorkbook
            Else
                WS.Move After:=SH
            End If
            Set SH = ActiveSheet
            End If
    Next WS
   
    Set WB = ActiveWorkbook
   
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Reconciliation" & "_" & Format(Date - Day(Date), "mmm-yy"), FileFormat:= _
        51, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
            , CreateBackup:=False
 
    End Sub

Hello,

I am trying to move multiple sheets to new work book and then save. But in the attached code, the macro is trying to save to the Macro sheet itself.

My macro file create multiple sheets after certain formatting work then it moves to new workbook and save. But the coding does not save the new workbook which creates through the coding.

 

[Hareesh_KLD]

Hi, try following code, it will move all worksheets except sheet1 to new workbook and will save with name Mybook on desktop

Sub MoveSheets()

    Dim wb As Workbook
    Dim ws As Worksheet
   
    Application.ScreenUpdating = False
   
    Set wb = Workbooks.Add
   
    For Each ws In ThisWorkbook.Worksheets
   
        If Not ws Is Sheet1 Then
       
            ws.Move after:=wb.Sheets(Worksheets.Count)
           
        End If
   
    Next ws
   
    wb.SaveAs "C:\Users\h\Desktop\Mybook.xlsx"
   
    wb.Close
   
    Application.ScreenUpdating = True
   
End Sub