Copy- Paste a workbook to a new one

[nikolacm]

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 ?

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

 

[nikolacm]

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.

 

[GWteB]

If they need to be copied in the same (new) workbook, this might give you a start.

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