PDA

View Full Version : 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

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)


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
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

Prabhu
09-06-2011, 09:35 PM
Hi Friends,

Thanks a lot for your help!

Regards,

Prabhu