Find part of 'Text' then copy that row and one above to worksheet

[leeksleeks]

Hi,

I have been looking for some code to find a row within "Sheet1" containing a word with a question mark next to it and then copy that row and the row above to the next worksheet "Sheet2". I have tried other peoples codes but they dont incorporate finding part of a word. Below is the code I have been trying but I cannot get this to find the questionmark attached to the word. Also this code doesnt copy the row above either. Any help with this would be greatly appreciated.

Sub CopyRows()    Dim bottomL As Integer
    bottomL = Sheets("Sheet1").Range("L" & Rows.Count).End(xlUp).Row
     
    Dim c As Range
    For Each c In Sheets("Sheet1").Range("A1:Z170" & bottomL)
        If c.Value = "*?" Then
            c.EntireRow.Copy Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next c
     
End Sub

 

[Rick Rothstein]

I have been looking for some code to find a row within "Sheet1" containing a word with a question mark next to it and then copy that row and the row above to the next worksheet "Sheet2". I have tried other peoples codes but they dont incorporate finding part of a word. Below is the code I have been trying but I cannot get this to find the questionmark attached to the word. Also this code doesnt copy the row above either. Any help with this would be greatly appreciated.

Sub CopyRows()    Dim bottomL As Integer
    bottomL = Sheets("Sheet1").Range("L" & Rows.Count).End(xlUp).Row
     
    Dim c As Range
    For Each c In Sheets("Sheet1").Range[COLOR=#000000]([/COLOR][COLOR=#FF0000][B]"A1:Z170" & bottomL[/B][/COLOR])
        If c.Value = "*?" Then
            c.EntireRow.Copy Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next c  
End Sub

First off, I think the part I highlighted in red is incorrect... I cannot believe you want to concatenate those values, rather, I think you want the bottomL to be lowest row of the range so that is what I used below. With that said, I think this code will do what you want...

Sub CopyRows()
  Dim bottomL As Integer
  bottomL = Sheets("Sheet1").Range("L" & Rows.Count).End(xlUp).Row
   
  Dim c As Range
  For Each c In Sheets("Sheet1").Range("A1:Z" & bottomL)
    If c.Value Like "*[A-Za-z][?]*" Then
      c.Offset(-1).Resize(2).EntireRow.Copy Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
  Next c
End Sub

 

[leeksleeks]

Thank you so much Rick. That works perfectly!!!