Copy Sheets of a specific color from multiple workbooks into 1 consolidated file

[z3115]

Hi,

I'm trying to take all the sheets of a specific color (in my code below it's light blue) from a group of workbooks and combine them into one new workbook.

This code works for the first file, but then gives me a "subscript out of range" error when trying to copy the tabs from the second file.

Code:

Sub SelectByTabColor()
'Currently set to Excel's standard light blue color
  Dim wsNames() As String
  Dim wsColor() As Integer
  Dim ws As Worksheet
  Dim ind As Integer
  
  ReDim wsNames(0)
  ReDim wsColor(0)
  wsNames(0) = ActiveSheet.Name
  wsColor(0) = ActiveSheet.Tab.ColorIndex
  
  Application.DefaultSaveFormat = 51 'Force default new sheet to be .xlsx instead of .xls
Workbooks.Add 'add new workbook
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Consolidated File - " & Format(Date, "mm.dd.yy") & ".xlsx", FileFormat:=51 'save new workbook
  
  'Repeatable part of the code, needed for each file:
'Put file path of source file below (after "Filename")
Workbooks.Open Filename:="Source file path 1.xlsm", UpdateLinks:=0


  For Each ws In ActiveWorkbook.Sheets
      If ws.Tab.Color = 15773696 And ws.Tab.TintAndShade = 0 And ws.Visible = xlSheetVisible Then
      ReDim Preserve wsNames(UBound(wsNames) + 1)
      ReDim Preserve wsColor(UBound(wsColor) + 1)
      wsNames(UBound(wsNames)) = ws.Name
      wsColor(UBound(wsColor)) = ws.Tab.ColorIndex
    End If
  Next ws
  Sheets(wsNames).Copy _
    after:=Workbooks("Consolidated File - " & Format(Date, "mm.dd.yy") & ".xlsx").Sheets(3)
    'Close source workbook:
        Workbooks("SourceFile1.xlsm").Activate
        Application.CutCopyMode = False 'Clears clipboard
        Workbooks("Source file 1").Close SaveChanges:=False
        
'Put file path of source file below (after "Filename")
Workbooks.Open Filename:="Source File path 2", UpdateLinks:=0


  For Each ws In ActiveWorkbook.Sheets
      If ws.Tab.Color = 15773696 And ws.Tab.TintAndShade = 0 And ws.Visible = xlSheetVisible Then
      ReDim Preserve wsNames(UBound(wsNames) + 1)
      ReDim Preserve wsColor(UBound(wsColor) + 1)
      wsNames(UBound(wsNames)) = ws.Name
      wsColor(UBound(wsColor)) = ws.Tab.ColorIndex
    End If
  Next ws


' THIS IS WHERE I KEEP GETTING THE ERROR: 
Sheets(wsNames).Copy _
    after:=Workbooks("Consolidated File - " & Format(Date, "mm.dd.yy") & ".xlsx").Sheets(3)
    
    'Close source workbook:
        Workbooks("Source file 2").Activate
        Application.CutCopyMode = False 'Clears clipboard of source file so Excel does not prompt you to keep/discard info on clipboard
        Workbooks("Source file 2").Close SaveChanges:=False
    
        
        


End Sub

This is so frustrating, because it works fine for the first file it "grabs" from, but I can't repeat it! I feel so close but yet so far, any help would be SUPER appreciated. Thank you!!!

(Full disclosure: I found most of this code online, so I don't fully understand how it works)

 

[ChrisM]

I'm not sure if this is your only problem, but wsNames is an array variable, it needs to be used with parentheses

Sheets(wsNames(1)).Copy _

 

[z3115]

This was helpful, thank you Chris. I feel close but that led me to a follow up question I was hoping you could help with:

Adding in a "1" in parentheses after "wsNames" prevents the error, and copies the first blue sheet, but I need all the blue sheets copied over. Changing that "1" to a "2" Copies just the second blue sheet, so is there a way to have it copy all the sheets in the wsNames array without knowing how many sheets that will be?

 

[z3115]

Just to clarify, I want to copy every sheet in the wsNames array, but the number of sheets in this array will vary each time I use the macro. So is there a way to copy all sheets referred to in the array?

 

[ChrisM]

Rather than loop through all sheets and record the names, just loop and copy as you go, like this:

 For Each ws In ActiveWorkbook.Sheets
      If ws.Tab.Color = 15773696 And ws.Tab.TintAndShade = 0 And ws.Visible = xlSheetVisible Then
         ws.Copy _
             after:=Workbooks("Consolidated File - " & Format(Date, "mm.dd.yy") & ".xlsx").Sheets(3)
    End If
  Next ws

 

[z3115]

Rather than loop through all sheets and record the names, just loop and copy as you go, like this:

 For Each ws In ActiveWorkbook.Sheets
      If ws.Tab.Color = 15773696 And ws.Tab.TintAndShade = 0 And ws.Visible = xlSheetVisible Then
         ws.Copy _
             after:=Workbooks("Consolidated File - " & Format(Date, "mm.dd.yy") & ".xlsx").Sheets(3)
    End If
  Next ws

This was just what I was looking for, awesome. Thank you!