Search for criteria in a column, cut and paste row to next empty row in new sheet

[cath1509]

Hi all!

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

I 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, the entire row will be cut and pasted onto the "Converted" worksheet.

I have managed (with some help!) to do this with my current code. However when you press the update button again, all the newly pasted rows on the Converted worksheet are deleted. (I would like when i press the update button it to NOT affect the Converted worksheet, just add any new data found on the Consolidated sheet to the Converted sheet.) I assume this is because my current code her below is NOT telling the spreadsheet to paste to the NEXT AVAILABLE EMPTY ROW. Please see 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 w1 As Worksheet
Dim w2 As Worksheet

Dim i as Long
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).Copy w2.Cells(Rows.Count, 1).End(xlUp).Offset(1)

               .Rows(i).Delete

 

            End If

   

        Application.CutCopyMode = False
    
     Next

 End With

 
End Sub

So the problem is this line:

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

I have attempted to replace this line with:

.Rows(i).Copy w2.Cells(Range("A65536")).End(x1Up).Offset(1, 0)

But there is something wrong as the code keeps breaking on that line!

Any help would be greatly appreciated. Thanks!

[AB33]

Cath,
This line is correct. It may be that column A is empty, so that the code keeps pasting the data on the next empty row . The code you have is not greate, but to write you a new code, I need to see the sample

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

[JOHN H. DAVIS]

Can you provide a sample which does that? At first site the code looks good to me.

[cath1509]

Hi - here is a sample and the entire code for the sample. I took out part of the code out (it didn't have anything to do with the question that I originally asked) or so i thought, as it seemed to be working okay...

Here is the entire code for the sample:

Dim sheetName As Variant

For Each sheetName In Array("Converted", "Lost-missed", "Novartis", "RBS", "RSA")

                  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("Novartis")

x = 7

    Do While Cells(x, 1) <> ""

   

        If Cells(x, 1) = "Novartis" Then

        w1.Rows(x).Copy

        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

   

 

 

Set w1 = Sheets("Consolidation")

Set w2 = Sheets("RBS")

x = 7

    Do While Cells(x, 1) <> ""

   

        If Cells(x, 1) = "RBS" Then

        w1.Rows(x).Copy

        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

   

   

   

Set w1 = Sheets("Consolidation")

Set w2 = Sheets("RSA")

x = 7

    Do While Cells(x, 1) <> ""

   

        If Cells(x, 1) = "RSA" Then

        w1.Rows(x).Copy

        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

 

 

Dim i As Long

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).Copy w2.Cells(Rows.Count, 1).End(xlUp).Offset(1)

               .Rows(i).Delete

 

            End If

   

        Application.CutCopyMode = False

    

     Next

 End With

 

Set w1 = Sheets("Consolidation")

Set w2 = Sheets("Lost-missed")

 

  

 With w1

 

       For i = .Cells(.Rows.Count, "E").End(xlUp).Row To 7 Step -1

   

            If .Cells(i, 5) = "Lost/Missed" Then

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

               .Rows(i).Delete

 

            End If

   

        Application.CutCopyMode = False

    

     Next

 End With


End Sub

And the attached workbook too...

Thanks!

[AB33]

So, what is the issue then?

[AB33]

You need to change this line

If Cells(x, 1) = "Novartis" Then

This implies the code will look at any sheet
INTO

If w1.Cells(x, 1) = "Novartis"

Then 'This implies the code will look at Set w1 = Sheets("Consolidation")