Copy- Paste a workbook to a new one

nikolacm

New Member
Joined
Mar 31, 2021
Messages
29
Office Version
  1. 365
Platform
  1. Windows
I am trying to export a workbook into a new one. My up to date code creates a new workbook which will include data from a single worksheet which have been copied and pasted. Although I am struggling to copy a second worksheet into the particular workbook. Any ideas how to deal with this issue ?

VBA Code:
Sub Export_Excel()
Dim ProjectWB As Workbook
Set ProjectWB = ThisWorkBook
' Define source wsheets
Dim InputWS As Worksheet
Dim CashFlowWS As Worksheet
'defining worksheets
Set InputWS = ProjectWB.Sheets("Input")
Set CashFlowWS = ProjectWB.Sheets("CF")
'folder's path
   Dim myPath As String
   myPath = Application.ActiveWorkbook.Path & "\"
'Create and define export workbook
 Dim NewProjectWB As Workbook
 Set NewProjectWB = Workbooks.Add
 'Create Broker Rec first sheet
 Set NewProjectWS = NewProjectWB.Sheets(1)
 'copy fist sheet
 'NewProjectWS.Name = "Input"
 'ProjectWB.Sheets(2).Copy After = NewProjectWB.Sheets(Sheets.Count)
 'Copy contents and format of first sheet
 InputWS.Cells.Copy
 NewProjectWS.Cells.PasteSpecial Paste:=xlPasteValues
NewProjectWS.Cells.PasteSpecial Paste:=xlPasteFormats
 Application.CutCopyMode = False
 NewProjectWS.Activate
 With ActiveWindow
      .Zoom = 80
      .DisplayGridlines = False
      .SplitColumn = 4
      .SplitRow = 4
      .FreezePanes = True
   End With
'new wb name
stPHASE = Range("C2")
stBLOCK = Range("C3")
stCLUSTER = Range("C4")
   Dim NewName As String
   NewName = myPath & stPHASE & "." & stBLOCK & "_" & stCLUSTER & ".xlsx"
   'Save workbook with new name
   ActiveWorkbook.SaveAs Filename:=NewName, FileFormat:=51
   'Target File Extension (must include wildcard "*")
   Dim myExtension As String
'Message Box when tasks are completed
  MsgBox "Export complete!"
End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Actually this code suits well with copy and paste of a workbook with one worksheet into a brand new workbook which will be saved according to the code. However, I am still struggling to find a way to copy and paste multiple worksheets in a brand new workbook.
 
Upvote 0
If they need to be copied in the same (new) workbook, this might give you a start.

VBA Code:
Sub nicolacm()
    
    Dim ProjectWB As Workbook
    Set ProjectWB = ThisWorkbook
    
    ' Define source wsheets
    Dim InputWS As Worksheet
    Dim CashFlowWS As Worksheet
    
    'defining worksheets
    Set InputWS = ProjectWB.Sheets("Input")
    Set CashFlowWS = ProjectWB.Sheets("CF")
    
    'folder's path
    Dim myPath As String
    myPath = Application.ActiveWorkbook.Path & "\"
    
' ==========================================================
    Dim NewProjectWS As Worksheet
    ' copy first sheet to an entire new workbook
    InputWS.Copy
    ' get a proper reference to created copy
    Set NewProjectWS = ActiveSheet
    ' temporary disable auto calculation
    Excel.Application.Calculation = xlCalculationManual
    ' ignore formulas, keep values and formatting
    NewProjectWS.UsedRange.Value = NewProjectWS.UsedRange.Value
    With ActiveWindow
        .Zoom = 80
        .DisplayGridlines = False
        .SplitColumn = 4
        .SplitRow = 4
        .FreezePanes = True
    End With
    ' copy second sheet after first copy
    CashFlowWS.Copy After:=NewProjectWS
    ' get a proper reference to created copy
    Set NewProjectWS = ActiveSheet
    ' ignore formulas, keep values and formatting
    NewProjectWS.UsedRange.Value = NewProjectWS.UsedRange.Value
    ' reenable auto calculation
    Excel.Application.Calculation = xlCalculationAutomatic
' ==========================================================
    
    'new wb name
    stPHASE = Range("C2")       ' << ranges are not qualified so the active sheet is used!
    stBLOCK = Range("C3")
    stCLUSTER = Range("C4")

    Dim NewName As String
    NewName = myPath & stPHASE & "." & stBLOCK & "_" & stCLUSTER & ".xlsx"

    'Save workbook with new name
    NewProjectWS.Parent.SaveAs FileName:=NewName, FileFormat:=51

    'Target File Extension (must include wildcard "*")
    Dim myExtension As String
    'Message Box when tasks are completed
    MsgBox "Export complete!"
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top