Copy Sheets To New Workbook And Save

**Prabhu** · 08-31-2011, 05:35 PM

Hi Friends,

I need VBA code for copy existing sheet(s) in to a new workbook.

i.e. I needs to copy two sheets (Active sheet and previous to the active sheet)from a workbook and the same two sheet needs to same as a new work book In a specified location with specified name(example like "Statement as on 31stAugust 2011(current date)"
Note:Sheet name may varies.I need to copy active and previous to the active sheet

Plz any one can help me to get the same.

Regards,

Prabhu

**Excel Fox** · 08-31-2011, 09:00 PM

Try this

Code:

Sub SaveCurrentAndPreviousSheetToNewWorkbook()

    Dim wbk As Workbook
    Dim wbkActive As Workbook
    Dim lngSheetsDefaultCount As Long
    
    Set wbkActive = ActiveWorkbook
    If ActiveSheet.Index < 2 Then
        MsgBox "There are no previous sheets before the current sheet!", vbInformation
        Exit Sub
    End If
    lngSheetsDefaultCount = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 2
    Set wbk = Workbooks.Add
    Application.SheetsInNewWorkbook = lngSheetsDefaultCount
    wbkActive.ActiveSheet.UsedRange.Copy wbk.Sheets(2).Cells(1)
    wbkActive.ActiveSheet.Previous.UsedRange.Copy wbk.Sheets(1).Cells(1)
    wbk.SaveAs wbkActive.Path & Application.PathSeparator & "Statement As On " & FormatDateTime(Date, vbLongDate)
    
End Sub

**Admin** · 08-31-2011, 10:30 PM

Hi Prabhu,

Welcome to ExcelFox !!!

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

**Prabhu** · 08-31-2011, 11:13 PM

Hi Friend,

Thanks it is working, A small change required.

1) Both sheets needs to remain as the original sheets name(from where we copied)
2) New workbook needs to save in a specified location. Example"D:\Reports"

Plz help to amend the code.

Regards,

Prabhu

**Excel Fox** · 08-31-2011, 11:17 PM

Code:

Sub SaveCurrentAndPreviousSheetToNewWorkbook()

    Dim wbk As Workbook
    Dim wbkActive As Workbook
    Dim lngSheetsDefaultCount As Long
    
    Set wbkActive = ActiveWorkbook
    If ActiveSheet.Index < 2 Then
        MsgBox "There are no previous sheets before the current sheet!", vbInformation
        Exit Sub
    End If
    lngSheetsDefaultCount = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 2
    Set wbk = Workbooks.Add
    Application.SheetsInNewWorkbook = lngSheetsDefaultCount
    wbkActive.ActiveSheet.UsedRange.Copy wbk.Sheets(2).Cells(1)
    wbk.Sheets(2).Name = wbkActive.ActiveSheet.Name
    wbk.Sheets(1).Name = wbkActive.ActiveSheet.Previous.Name
    wbkActive.ActiveSheet.Previous.UsedRange.Copy wbk.Sheets(1).Cells(1)
    wbk.SaveAs "D:\Reports\" & "Statement As On " & FormatDateTime(Date, vbLongDate)
    
End Sub