Save and delete extra worksheets

[NMGMX]

I have a workbook and want to delete all sheets after Worksheet X (orderwise not namewise). But first I want to save them to a separate workbook. What is the best way to do this?

 

[ozbod]

Rather than save and delete, move them to a new workbook and then save the new workbook

sname = ActiveWorkbook.Name 'Source workbook

Workbooks.Add 

tName = ActiveWorkbook.Name  'Target workbook

For n = 4 To 6 ' whatever your criteria

    Workbooks(sname).Sheets(n).Move After:=Workbooks(tName).Sheets(Sheets.Count - 1)

Next n

 

[NMGMX]

For the life of me I cannot figure out why the code won't work!

Workbooks.Add
ActiveWorkbook.SaveAs Filename:=WorkbookNm & " (Misfit Categories)"
    mname = ActiveWorkbook.Name
For n = 33 To Workbooks(WorkbookNm & ".xlsm").Sheets.Count
    MsgBox Workbooks(WorkbookNm & ".xlsm").Sheets(n).Name
    Workbooks(WorkbookNm & ".xlsm").Sheets(n).Move After:=Workbooks(mname).Sheets(Sheets.Count - 1)
Next n

I get no error, and the new workbook appears, but it doesn't have my sheets. The MsgBox returns the right column(s), but for some reason it looks like they don't move over, why?

 

[ozbod]

That's because it is always referencing the new workbook. Define the source name before you add the workbook

SourceName = ActiveWorkbook.Name 'Name of the workbook you are moving the sheets from

Workbooks.Add

ActiveWorkbook.SaveAs Filename:=WorkbookNm & " (Misfit Categories)"
    mname = ActiveWorkbook.Name

For n = 33 To Workbooks(SourceName).Sheets.Count
    MsgBox Workbooks(SourceName).Sheets(n).Name
    Workbooks(SourceName).Sheets(n).Move After:=Workbooks(mname).Sheets(Sheets.Count - 1)
Next n

 

[NMGMX]

That's because it is always referencing the new workbook. Define the source name before you add the workbook

SourceName = ActiveWorkbook.Name 'Name of the workbook you are moving the sheets from

Workbooks.Add
ActiveWorkbook.SaveAs Filename:=WorkbookNm & " (Misfit Categories)"
    mname = ActiveWorkbook.Name

For n = 33 To Workbooks(SourceName).Sheets.Count
    MsgBox Workbooks(SourceName).Sheets(n).Name
    Workbooks(SourceName).Sheets(n).Move After:=Workbooks(mname).Sheets(Sheets.Count - 1)
Next n

It actually wasn't. It used WorkbookNm to refer to the original worksheet. I actually ended up using Sheets(Sheets.Count) instead of Sheets(Sheets.Count - 1), and it worked. Thanks anyways.
Final Code:

    Workbooks.Add    ActiveWorkbook.SaveAs Filename:=WorkbookNm & " (Misfit Categories)"
    Dim mname As String
    mname = ActiveWorkbook.Name
For n = 33 To Workbooks(WorkbookNm & ".xlsm").Sheets.Count
    Workbooks(WorkbookNm & ".xlsm").Sheets(n).Move After:=Workbooks(mname).Sheets(Sheets.Count)
    Workbooks(WorkbookNm & ".xlsm").Sheets(n).Delete
Next n
    Workbooks(mname).Sheets(1).Delete
    Workbooks(mname).Save