CODEWITHSUNDEEP
excelvba
Arelius
Arelius

Reputation: 90

Move or copy sheet to new workbook

Sub ED() looks at the window with the workbook/file named 'PR11_P3.xlsm', and then counts to the last sheet, and selects it. Then it moves it (not copy) into a new file and saves this to a path/destination.

Sub ED() 'Export last sheet into new file in the background, save as and close

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Windows("PR11_P3.xlsm").Activate
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Move
    ActiveWorkbook.SaveAs Filename:="C:\Temp\PR\Export\Bok1.xlsx", FileFormat:= _
      xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

I have an error when there is no last sheet. Best case scenario I think would be to do an If:

I want to make sure that there is no scenario where code outputs an error due to the sheet count. Since the name of the second sheet is always different this is my approach. There are errors.

Sub ED_IF() 

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
If Sheets(Sheets.Count) =< 3 Then 'not more than two sheets
Windows("PR11_P3.xlsm").Activate
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Move
ActiveWorkbook.SaveAs Filename:="C:\Temp\PR\Export\Bok1.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Else
If Sheets(Sheets.Count) = 1 or => 2 Then 'basically if there is only one sheet or more than 2 sheets, so it can be any number above 2
Windows("PR11_P3.xlsm").Activate
Sheets(Sheets.Count).Copy
ActiveWorkbook.SaveAs Filename:="C:\Temp\PR\Export\Bok1.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End If
End If

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Upvotes: 1

Views: 90

Answers (1)

Tim Williams
Tim Williams

Reputation: 166306

Something like this:

Sub ED() 'Export last sheet into new file in the background, save as and close
    Dim wb As Workbook, ws As Worksheet, wbNew As Workbook, nSheets As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wb = Workbooks("PR11_P3.xlsm")   'or ThisWorkbook?
    nSheets = wb.Worksheets.Count
    Set ws = wb.Worksheets(nSheets)  'sheet to copy/move
    
    With Workbooks.Add(xlWBATWorksheet) 'add a new workbook with 1 sheet
        Select Case nSheets
            Case 1: ws.Copy after:=.Sheets(1)
            Case Else: ws.Move after:=.Sheets(1)
        End Select ' fixed
        .Sheets(1).Delete 'remove the empty sheet
        .SaveAs Filename:="C:\Temp\PR\Export\Bok1.xlsx", _
             FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Close
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Upvotes: 4

Related Questions