Vba Excel, Need to copy Sheets and past one line below main sheet.

What I wanna do:

At the end of this program I wanna add to it and make it Copy All 1D_1, 1D_2, 1D_3, 1D_4, 1D_5, 1D_6. An past them Onto Sheet called Comingsoon_report here is the catch some times there may be only up to 1D_5 or only up to 1D_3 I don't want it to Error out if that was to happen. Also I want it to post 1 line Below any text in Cell A on the page Comingsoon_report

Can any one help me I am new to VBA.
Please help

  Sub run()
            Dim r As Range
            Dim s As String
            Dim ws As Worksheet
            For Each ws In ActiveWorkbook.Sheets
                Select Case ws.Name
                    Case "1D_report"
                        With ws
                            .Rows("3:9").Delete Shift:=xlUp
                            .Range("E1:F2").ClearContents
                            .Range("H:H").ClearContents
                        End With
                        If Not SearchAndClear(ws, "Utilization, %", 8, 0) Then Exit Sub
                        If Not SearchAndClear(ws, "Utilization, %", 0, 1) Then Exit Sub
                        If Not SearchAndClear(ws, "Total Cost:", 0, 1) Then Exit Sub
                        ws.Name = "Comingsoon_report"
    
                    Case "1D_1", "1D_2", "1D_3", "1D_4", "1D_5", "1D_6"  '<-- Work sheets!
                        With ws
                            .Rows("4:9").Delete Shift:=xlUp
                            .Rows("2").Delete Shift:=xlUp
                        End With
                        'If Not SearchAndClear(ws, "Qty:", 0, 1) Then Exit Sub <--- Extra Search and delete If Need
    
                        Set r = ws.Cells.Find(What:="Page", After:=ws.Range("E8"), LookIn:=xlFormulas, LookAt _
                            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                            False, SearchFormat:=False)
                        r.Replace What:="Page", Replacement:="Program", LookAt:=xlPart, _
                            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                            ReplaceFormat:=False
                    
    
                    Case Else
                    'You could add additional logic for other worksheets, if needed
    
    
    
                End Select
             
                
    Next ws
    
        End Sub
        Function SearchAndClear(ws As Worksheet, srchString As String, rOff As Long, cOff As Long) As Boolean
        With ws
            Set r = .Cells.Find(srchString, .Range("A1"))
            If r Is Nothing Then
                MsgBox s & " could not be found" & vbCrLf & "I'am going on break"
                SearchAndClear = False
            End If
            .Range(r, r.Offset(rOff, cOff)).Clear
            SearchAndClear = True
        End With
    End Function