Copying specific worksheets to a new workbook

[lcp3]

I'm trying to take specific worksheets from an existing workbook and move them to a new workbook, but running into issues. In the below snip, I want to move the Lineup tab, along with Ship 1 - Ship 12 and PO Recap tabs to a new workbook, but exclude COGS, PWC and Test.UPC tabs.

Below is where I'm currently at, but obviously missing a few steps. Any suggestions?

Sub CopySheetsToNewWorkbook()
'Copy sheets to a new Workbook.

Dim numSheets As Integer
numSheets = Application.Sheets.Count - 3
Dim aSheets() As String
ReDim aSheets(numSheets - 1)


For i = 0 To numSheets - 1
aSheets(i) = ActiveWorkbook.Worksheets(i + 1).Name
Next i
ActiveWorkbook.Worksheets(aSheets()).Select
ActiveWorkbook.Worksheets(aSheets()).Copy
ActiveWorkbook.Worksheets(aSheets()).Select

Range("A1:BZ1176").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False

ActiveSheet.Select

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True

End Sub

 

[HaHoBe]

Hi lcp3,

what about

Sub MrE1612613()
'https://www.mrexcel.com/board/threads/copying-specific-worksheets-to-a-new-workbook.1219951/
Dim arr()
Dim lngCount As Integer
Dim lngArr As Integer

For lngCount = 1 To Worksheets.Count
  Select Case Worksheets(lngCount).Name
    Case "COGS", "PWC", "Test.UPC"
    Case Else
      lngArr = lngArr + 1
      ReDim Preserve arr(1 To lngArr)
      arr(lngArr) = Worksheets(lngCount).Name
    End Select
Next lngCount

Worksheets(arr).Copy
End Sub

Ciao,
Holger

 

[lcp3]

That worked, Thank You! One more wrinkle, I'd like to paste values only.

 

[HaHoBe]

Hi lcp3,

maybe

Sub MrE1612613_V2()
'https://www.mrexcel.com/board/threads/copying-specific-worksheets-to-a-new-workbook.1219951/
Dim arr()
Dim lngCount As Long
Dim lngArr As Long
Dim ws As Worksheet

For lngCount = 1 To Worksheets.Count
  Select Case Worksheets(lngCount).Name
    Case "COGS", "PWC", "Test.UPC"
    Case Else
      lngArr = lngArr + 1
      ReDim Preserve arr(1 To lngArr)
      arr(lngArr) = Worksheets(lngCount).Name
    End Select
Next lngCount

Worksheets(arr).Copy

For Each ws In Worksheets
  With ws.UsedRange
    .Value = .Value
  End With
Next ws
End Sub

or

Sub MrE1612613_V3()
'https://www.mrexcel.com/board/threads/copying-specific-worksheets-to-a-new-workbook.1219951/
Dim arr()
Dim lngCount As Long
Dim lngArr As Long
Dim ws As Worksheet

For lngCount = 1 To Worksheets.Count
  Select Case Worksheets(lngCount).Name
    Case "COGS", "PWC", "Test.UPC"
    Case Else
      lngArr = lngArr + 1
      ReDim Preserve arr(1 To lngArr)
      arr(lngArr) = Worksheets(lngCount).Name
    End Select
Next lngCount

Worksheets(arr).Copy

For Each ws In Worksheets
  ws.UsedRange.Copy
  ws.Range("A1").PasteSpecial xlPasteValues
Next ws
End Sub

Ciao,
Holger

 

[lcp3]

That worked! Thank you!!

 

[HaHoBe]

Hi lcp3,

maybe consider to act according to Mark as Solution. Thanks for the feedback.

Ciao,
Holger