VB - Copy all rows with cell like ''

Question

I am trying to create a macro that will search through my range and copy the entire row where cell like '*01'. It copies and paste to the sheet i need but it loops and copies just the same row, maybe i dont need the loop if there is an easier way to accomplish this. again all I really need is to copy all the rows that have a cell like'*01'and paste it in my new worksheet. This goes to every 5 rows down looking for the cell with that value. Thank you so much!

     Sub Macro3()
  'ctrl + l
  Dim GetBook As String

Dim cell As Range
Dim SrchRng As Range

GetBook = ActiveWorkbook.Name


Set SrchRng = ActiveSheet.Range("d7:d500")

Do Until IsEmpty(ActiveCell)
For Each cell In SrchRng
'And IsEmpty(ActiveCell.Offset(5, 0))
      If cell Like "*01" Then cell.Offset(0, 0).EntireRow.Copy
    Next cell

 Loop

    Windows("TestCov.xlsx").Activate
    ActiveWindow.WindowState = xlNormal

 Range("iv1").End(xlToLeft).Offset(0, 1).Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

        Windows(GetBook).Activate
    ActiveCell.Offset(5, 0).Select

What exactly is this address? Range("iv1").End(xlToLeft).Offset(0, 1).Select You're starting with a fixed location, going to the a sub-range within it (which is only one cell, so it's going to return the same thing you started with), then offsetting from there. Why not Range("iv2") and be done with it? — Denise Skidmore
I needed that iv1 part because it paste in a new sheet into the first empty column (fist empty cell at row one) and since i dont know how many copied rows their will be i need it to find the next available — user3232261

Denise Skidmore Denise Skidmore · Accepted Answer · 2014-05-27T21:38:13

I had to completely re-write. You will have to write different code to set destination start and the search range.

Sub Macro3()
    Dim SrchRng As Range
    Dim destination As Range
    Set destination = Workbooks("Book1").Worksheets("Sheet2").Range("A2")
    Set SrchRng = Workbooks("Book1").Worksheets("Sheet1").Range("A2:A500")

    For Each source In SrchRng
        If source.Text Like "*01" Then
            source.EntireRow.Copy
            destination.PasteSpecial _
                Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Set destination = destination.Offset(1, 0)
        End If
    Next source
End Sub

VB - Copy all rows with cell like ''

1 Answers