Select Different Sheets Based on Criteria VBA

[austinandreikurt]

Hi,
I have a list of specific Sheet names in Column B of Sheets("MAIN") which starts in B3 and is dynamic to the last non-blank row and the "YES" and "NO" in Column A. So basically, what I need is to find the vba script to select all the sheet names with "YES" as values in Column A. Then move those selected sheets to another workbook and save it will filename "Summary_" & Date & ".xlsx" then select the previous workbook again. I can do the other codes, I just really need a simple code for selecting the sheetnames with "YES". Thanks!

 

[Trebor76]

Hi there,

Try this:

Option Explicit
Sub Macro1()

    Dim strMySheets() As String
    Dim lngArrayCount As Long
    Dim lngLastRow As Long
    Dim wbThisWB As Workbook
    Dim wbNewWB As Workbook
    Dim rngMyCell As Range
   
    Application.ScreenUpdating = False
   
    Set wbThisWB = ThisWorkbook
   
    With wbThisWB.Sheets("MAIN")
        lngLastRow = .Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each rngMyCell In .Range("A3:A" & lngLastRow)
            If StrConv(rngMyCell.Value, vbUpperCase) = "YES" And Len(rngMyCell.Offset(0, 1).Value) > 0 Then
                lngArrayCount = lngArrayCount + 1
                ReDim Preserve strMySheets(1 To lngArrayCount)
                strMySheets(lngArrayCount) = CStr(rngMyCell.Offset(0, 1))
            End If
        Next rngMyCell
    End With
   
    wbThisWB.Sheets(strMySheets).Copy
    Set wbNewWB = ActiveWorkbook
    wbNewWB.SaveAs "D:\Robert\Summary_" & Format(Now(), "YYYYMMDD") & ".xlsx", FileFormat:=51 'Change the directory where the file is to be saved to suit.
   
    wbThisWB.Activate
   
    Application.ScreenUpdating = True
   
End Sub

Regards,

Robert

 

[austinandreikurt]

Awesome, this is exactly what I needed. Thanks Trebor!

 

[Trebor76]

Thanks for letting us know and you're welcome