Search Term All Sheets - Copy Next 6 rows

[Logit]

Looking for a VBA macro to search for a term in all sheets ("Follow-Up Required"), then copy the next 6 rows below the row containing the term, paste those six rows to a master sheet starting at the first available blank row.

There are approx. 100 sheets in the workbook containing the term ... The term is always located in Col B ... and the Term and 6 rows are always at the bottom of the Used Range but the row #'s will vary from sheet to sheet. The master sheet name is "Follow-Up" and is Sheet24.

I can get the macro to search and locate the term but cannot determine how to copy the next six rows for pasting.

Thank you for your help.

 

[Chihiro]

Can you post how you located the term (code)? That will determine how you'll grab next 6 rows.

 

[Logit]

Option Explicit

Sub Button1_Click()
    Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("Sheet1")  'specify sheet name here to paste to
    x = 3  'begins pasting in Sheet 1 on row 2
    Application.ScreenUpdating = 0
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col D all sheets
                Set Rng = .Range(.Cells(1, "B"), .Cells(Rws, "B"))
                For Each c In Rng.Cells
                    If c.Value = "Follow-Up Required" Then  'searches for term NO
                        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                        x = x + 1
                    End If
                Next c
            End With
        End If
    Next sh
End Sub

 

[Chihiro]

Try changing code to something like...

                    If c.Value = "Follow-Up Required" Then  'searches for term NO
                      c.Resize(6).EntireRow.Copy Destination:=ws.Cells(x, "A")
                        x = x + 6
                    End If

Adjust Resize value & + 6 as needed to increase or decrease.

 

[Logit]

Works like a charm ! Thank you.

 

[Logit]

I spoke too soon. The code works in my test workbook but not in the target workbook.

I get a RunTime Error "Type MisMatch" 13 on this line in the macro :

If c.Value = "Follow-Up Required" Then  'searches for term NO

The target workbook is attached. It had to be zipped due to size.

I made certain the spelling of the Term was correct, the Term was located in Col B on the sheets where it is located. Made certain the Sheet Tab Name was correct in the code. I'm lost.

Thank you for your assistance.

 

[Chihiro]

That's because your Sheet2, Cell B6 contains error.

Add additional check like below.

                    If Not IsError(c) Then
                        If c.Value = "Follow-Up Required" Then  'searches for term NO
                            c.Resize(7).EntireRow.Copy Destination:=ws.Cells(x, "A")
                            x = x + 7
                        End If
                    End If

 

[Logit]

Thank you for locating the error and the edited macro code.

One last question if you do not mind ?

The Col for LOCATION is copying the formulas from the individual sheets but it is not copying the VALUES in the cells. Realistically, it only needs to copy the VALUES to be pasted in the FOLLOW-Up sheet for that column.

Thank you !

 

[Chihiro]

In order to do that, you'd need to get rid of merged cells. Otherwise, there's no direct way to paste values only.

 

[Marc L]

Looking for a VBA macro to search for a term in all sheets ("Follow-Up Required"), then copy the next 6 rows

Looking for a crystal clear explanation as according to your attachment
explain the need for Maintenance Summary worksheet for example …
As it is easy to join a before and an after workbooks !
And of course the destination worksheet should have same layout
as source data worksheets …
​

 

[Logit]

Most sheets have a section entitled : Follow-up Required

Pic Link:

https://www.amazon.com/clouddrive/share/riciviASXQQnqIoTfDcsW4BwoKHLswWN9tQPWj1ofCF


It is this information that needs to be copied and pasted to the Follow-up sheet as a condensed record of maintenance needs. Because the code is copying the entire rows there should not be a need for formatting.

Chihiro provided an excellent solution to finding the term "Follow-Up Required" and then copying the next 6 rows. However, due to formulas in the LOCATION column, the values in the cells are not being copied.

The challenge now is to be able to add to the existing code enabling the capture of the cell values. Chihiro had mentioned about eliminating "merged cells" but I am uncertain which cells he is referring to.

Thank you both for your assistance.

 

[Chihiro]

It's Header row for "Maintenance Summary" sheet (Row 20), as well as most other sheets' header row right after "Follow-up Required" cell.

Instead of merged cells, unmerge and format cells across selection.


Once you fixed that. You can update your code to something like...

                    If Not IsError(c) Then
                        If c.Value = "Follow-Up Required" Then  'searches for term NO
                            c.Offset(, -1).Resize(7, 15).Copy
                            With ws.Cells(x, "A")
                                .PasteSpecial xlPasteFormats
                                .PasteSpecial xlPasteValues
                            End With
                            x = x + 7
                        End If
                    End If

 

[Logit]

Thank you so much. Kudos to both !