VBA Copying Multiple sheets selected Data ranges to a workbook by creating a new workbook automatically

Question

I have a workbook of 80 worksheets,and I want to select only 4 worksheets with selected range. I want to copy this range a new workbook automatically. I have run a macro and this code below.

Sub TestTest()
'
 ' TestTest Macro
 '

 '
  Sheets("Summary").Select
  Range("A1:O54").Select
  Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="Newworkbook.xlsx", 
 FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
Windows("").Activate
Sheets("").Select
Range("").Select
Selection.Copy
Windows("Newworkbook.xlsx").Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("").Activate
Sheets("").Select
Range("").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Newworkbook.xlsx").Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("").Activate
Sheets("").Select
Range("").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Newworkbook.xlsx").Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("").Activate
Sheets("").Select
ActiveWindow.SmallScroll Down:=-18
Range("").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Newworkbook.xlsx").Activate
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("").Activate
Range("N29").Select
End Sub

Answer 1

I believe it should work as you expect it to, it will copy all five ranges and paste them into a new workbook, renaming each of the sheets appropriately and then save the newly created workbook to your desired location, you might want to add something to the name of the new workbook you are creating, such as a date, so as to not give you any issues the next time you run the code, alternatively you could delete the previous report and overwrite it:

Sub Test()
Dim wsSummary As Worksheet: Set wsSummary = ThisWorkbook.Sheets("Summary")
Dim wsMeasured As Worksheet: Set wsMeasured = ThisWorkbook.Sheets("1. Measured Work")
Dim wsPreliminaries As Worksheet: Set wsPreliminaries = ThisWorkbook.Sheets("2. Preliminaries")
Dim wsFees As Worksheet: Set wsFees = ThisWorkbook.Sheets("3. Fees")
Dim wsContingency As Worksheet: Set wsContingency = ThisWorkbook.Sheets("4. Contingency")
Dim NewWorkBook As Workbook
'above declare and set the worksheets and workbook you are working with
Application.ScreenUpdating = False
    Set NewWorkBook = Workbooks.Add
    'add a new workbook

    wsSummary.Range("A1:O54").Copy 'copy first range
    NewWorkBook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    NewWorkBook.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
    'paste into first sheet in new workbook
    NewWorkBook.Sheets(1).Name = "Summary" 'rename the sheet in the new workbook

    wsMeasured.Range("B1:Q76").Copy 'copy second range
    NewWorkBook.Sheets.Add After:=ActiveSheet 'add a new sheet to the new workbook
    NewWorkBook.Sheets(2).Range("A1").PasteSpecial xlPasteValues
    NewWorkBook.Sheets(2).Range("A1").PasteSpecial xlPasteFormats
    'paste into second sheet in new workbook
    NewWorkBook.Sheets(2).Name = "1. Measured Work" 'rename the sheet in the new workbook

    wsPreliminaries.Range("B1:Q48").Copy 'copy third range
    NewWorkBook.Sheets.Add After:=ActiveSheet 'add a new sheet to the new workbook
    NewWorkBook.Sheets(3).Range("A1").PasteSpecial xlPasteValues
    NewWorkBook.Sheets(3).Range("A1").PasteSpecial xlPasteFormats
    'paste into third sheet in new workbook
    NewWorkBook.Sheets(3).Name = "2. Preliminaries" 'rename the sheet in the new workbook

    wsFees.Range("B1:Q47").Copy 'copy fourth range
    NewWorkBook.Sheets.Add After:=ActiveSheet 'add a new sheet to the new workbook
    NewWorkBook.Sheets(4).Range("A1").PasteSpecial xlPasteValues
    NewWorkBook.Sheets(4).Range("A1").PasteSpecial xlPasteFormats
    'paste into fourth sheet in new workbook
    NewWorkBook.Sheets(4).Name = "3. Fees" 'rename the sheet in the new workbook

    wsContingency.Range("B1:Q46").Copy 'copy fifth range
    NewWorkBook.Sheets.Add After:=ActiveSheet 'add a new sheet to the new workbook
    NewWorkBook.Sheets(5).Range("A1").PasteSpecial xlPasteValues
    NewWorkBook.Sheets(5).Range("A1").PasteSpecial xlPasteFormats
    'paste into fifth sheet in new workbook
    NewWorkBook.Sheets(5).Name = "4. Contingency" 'rename the sheet in the new workbook
    Application.CutCopyMode = False 'deselect copied range

    NewWorkBook.SaveAs Filename:="NewWorkBook.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    'save the newly created workbook
    NewWorkBook.Close
    'close the newly created workbook
Application.ScreenUpdating = True
End Sub