Few more Adjusments Wanted

[Plukey]

Below, Once the button is activated...it searches for "Y" in "A2:A" in all worksheets specified. It means that line is closed... Someone will enter a Y for yes Its Closed and transfer to Sheet "Closed PS" (This Person is not familiar with PC concepts) So we have to be gentle . A quick report is given ..Who - how many / & who -doesn't. I would like it to delete the original source and prompt within the preview box (Yes/Transfer & Delete) - (No Exit), basically... I can change the verbiage if need be. Currently, it just gives the preview and I have to delete original source manually.
I made it a button because they would get overwhelmed if It happened instantly with SheetChanged ..Advise welcomed please!

Option Explicit
Sub SearchForString()
    Dim FirstAddress As String, WhatFor As String
    Dim Cell As Range, Sheet As Worksheet
    Dim sSheetsWithData As String, sSheetsWithoutData As String
    Dim lSheetRowsCopied As Long, lAllRowsCopied As Long
    Dim bFound As Boolean
    Dim sOutput As String
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .CutCopyMode = False
    End With
    
    WhatFor = ("Y") <<<'I used to have a msg box..but decided not to, because it will always be Y'<<<
    If WhatFor = Empty Then Exit Sub
    
    For Each Sheet In Sheets
        If Sheet.Name <> "HOMEPAGE" And Sheet.Name <> "Other" And Sheet.Name <> "Closed PS" And Sheet.Name <> "Backlog to Research" And Sheet.Name <> "Pre-Scrap" Then
            bFound = False
            With Sheet.Columns(1)
                Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlWhole)
                If Not Cell Is Nothing Then
                    bFound = True
                    lSheetRowsCopied = 0
                    FirstAddress = Cell.Address
                    Do
                        lSheetRowsCopied = lSheetRowsCopied + 1
                        Cell.EntireRow.Copy Destination:=Sheets("Closed PS").Range("A" & rows.Count).End(xlUp).Offset(1, 0)
                        Set Cell = .FindNext(Cell)
                    Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
                Else
                    bFound = False
                End If
                If bFound Then
                    sSheetsWithData = sSheetsWithData & "    " & Sheet.Name & " (" & lSheetRowsCopied & ")" & vbLf
                    lAllRowsCopied = lAllRowsCopied + lSheetRowsCopied
                Else
                    sSheetsWithoutData = sSheetsWithoutData & "    " & Sheet.Name & vbLf
                End If
            End With
        End If
    Next Sheet
    
    If sSheetsWithData <> vbNullString Then
        sOutput = "Sheets with data (rows copied)" & vbLf & vbLf & sSheetsWithData & vbLf & _
            "Total rows copied = " & lAllRowsCopied & vbLf & vbLf
    Else
        sOutput = "No sheeTs contained data to be copied" & vbLf & vbLf
    End If
    
    If sSheetsWithoutData <> vbNullString Then
        sOutput = sOutput & "Sheets with no rows copied:" & vbLf & vbLf & sSheetsWithoutData
    Else
        sOutput = sOutput & "All sheets had data that was copied."
    End If
    
    If sOutput <> vbNullString Then MsgBox sOutput, , "Copy Report"
    
    With Worksheets("Closed PS")
        If .Cells(1, 1).Value = vbNullString Then .rows(1).Delete
    End With
    Application.EnableEvents = True
    
    Set Cell = Nothing
    
    
End Sub

 

[DanteAmor]

Sorry I can not help with the code, but at the moment I do not have enough time to try, plus I have to recreate the tables you use.

 

[Plukey]

Okay thank you

 

[DanteAmor]

You're welcome