Copy and Save Worksheets into a new workbook

[Iceman3395]

The coding below works fine. except it opens an extra workbook.

It copies all worksheet fine and save a workbook using the coding below.

Do not understand why it creates a nameless workbook as well.

Could use some help on this as I use the master workbook to input data to create about 50 other workbooks and like to do the input and create new works to save it. but when I do 10 I'll have about 10 nameless open workbooks to close.



'Save

'Module2 Saves only O&M data



'Copy and save As new workbook


Sub sb_Copy_Save_Worksheet_As_Workbook()
Dim wb As Workbook
Set wb = Workbooks.Add
'ThisWorkbook.Sheets("Master Sheet").Copy Before:=wb.Sheets(1)
ThisWorkbook.Sheets(Array("Master Sheet", "O&M Summary", "Elec Diesel Sub")).Copy

The Red coding is where the trouble is all the rest works fine.
The Green coding works just fine. I changed the coding so it would copy the 3 named worksheets to the new workbook instead of just the :Master Sheet"


Dim part1 As String
Dim part2 As String


part1 = Range("b1").Value
part2 = Range("h1").Value


ActiveWorkbook.SaveAs Filename:= _
"F:\O&M Consultant's Calculation" & part1 & "" & part1 & " O&M " & part2 & " .xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

'This deletes all buttons

ActiveSheet.Buttons.Delete

'Copy formula and Paste value in same Range
Range("b1").Copy
Range("b1").PasteSpecial Paste:=xlPasteValues

Range("c1").Copy
Range("c1").PasteSpecial Paste:=xlPasteValues

Range("d1").Copy
Range("d1").PasteSpecial Paste:=xlPasteValues

Range("h1").Copy
Range("h1").PasteSpecial Paste:=xlPasteValues

' Using Color Index
Range("B1").Interior.ColorIndex = 2
Range("C1").Interior.ColorIndex = 2
Range("D1").Interior.ColorIndex = 2
Range("E1").Interior.ColorIndex = 2
Range("F1").Interior.ColorIndex = 2
Range("G1").Interior.ColorIndex = 2
Range("H1").Interior.ColorIndex = 2
Range("H2").Interior.ColorIndex = 2
Range("C3").Interior.ColorIndex = 2


'Hides Unused Rows
Dim i As Long, HideRng As Range

Application.ScreenUpdating = False 'speed up execution by disabling screen updates
Range("A10:A154").EntireRow.Hidden = False 'unhide all rows at once

For i = 10 To 156 'cycle through all rows to possibly hide again
Select Case i 'only check specific rows
Case 10 To 11, 13 To 15, 17 To 20, 22 To 25, 32, 36 To 52, 59 To 76, 83 To 84, 91, 95 To 103, 106, 117, 120 To 126, 128 To 141, 143 To 156
If Range("B" & i) = False And Range("H" & i) = False Or Range("D" & i) = 0 Then
If HideRng Is Nothing Then Set HideRng = Range("A" & i) Else Set HideRng = Union(HideRng, Range("A" & i)) 'add to row collection
End If
End Select
Next i

If Not HideRng Is Nothing Then HideRng.EntireRow.Hidden = True 'hide all rows at once
Application.ScreenUpdating = True


'Saves workbook

ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub

 

[Fluff]

The line in red creates a new workbook, with the 3sheets. Therefore you can get rid of the line in green & the line above that (ie Workbooks.Add)

 

[Iceman3395]

Thanks. I thought of trying that but did want to screw up code.

 

[Fluff]

The best bet, when you're unsure, is to the relevant line of code into a comment ( as you have with the green line) & then run the macro.
If it goes wrong, simply uncomment the line in question