Copy & paste a row (without leaving an empty row behind!) if a cell contains a value

Hi all!

I have 2 worksheets, one called "Consolidated" and one called "Converted".

I would like to have a spreadsheet where I press the update button and a macro runs that searches for the word "Converted" in column E on the Consolidated spreadsheet (the original). When it finds it, I would like the entire row to be cut and pasted onto the "Converted" worksheet.

I have managed to do this with my current code:

  Sub All_Loops()
Dim sheetName As Variant
For Each sheetName In Array("Converted")

                  Sheets(sheetName).Range("A7:XFD1048576").Delete
Next sheetName


Dim erow As Long
Dim w1 As Worksheet
Dim w2 As Worksheet

     Set w1 = Sheets("Consolidation")
     Set w2 = Sheets("Converted")

          x = 7
        Do While Cells(x, 5) <> ""

   

        If Cells(x, 5) = "Converted" Then

        w1.Rows(x).Cut

        w2.Activate

        erow = w2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

        ActiveSheet.Paste Destination:=w2.Rows(erow)

        End If


    Worksheets("Consolidation").Activate
     x = x + 1
     Loop

    Application.CutCopyMode = False

 

End Sub

However when this macro runs, the row left behind on the original sheet is a blank row and I don't want this. I would like it to be continuous spreadsheet, not dotted with random blank rows!

If anybody can see a solution to this it would be greatly appreciated!

Thanks!!

You need to loop back ward if you wish to delete(cut) a row.

Option Explicit
Sub All_Loops()
Dim sheetName As Variant
For Each sheetName In Array("Converted")

Sheets(sheetName).Range("A7:XFD1048576").Delete
Next sheetName


Dim i As Long
Dim w1 As Worksheet
Dim w2 As Worksheet

Set w1 = Sheets("Consolidation")
Set w2 = Sheets("Converted")

   
 With w1

       For i = .Cells(.Rows.Count, "E").End(xlUp).Row To 7 step -1
    
            If .Cells(i, 5) = "Converted" Then
              .Rows(i).Cut
               w2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Paste
            End If
    
        Application.CutCopyMode = False
     
     Next
 End With
End Sub

Hi AB33,

Thanks for replying! I tried the code but it seems to be breaking on this part:

w2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Paste

Thanks!

Sorry! My bad!

Replace

.Rows(i).Cut
               w2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Paste

with

 .Rows(i).Cut w2.Cells(Rows.Count, 1).End(xlUp).Offset(1)

One line

Hey - did that! Unfortunately it is the same result as my code - the blank rows are still left behind on the original sheet

Please attaché a sample

Try these lines

 .Rows(i).copy w2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
              .Rows(i).Delete

Awesome that line of code worked! Thanks so much!