# Row copy loop when certain condition is met

#### bombay121

##### New Member
Hi Guys,

Second question of the day, I am a complete amateur at this so please bare with me. I've written the below code to copy and paste rows from one sheet to another when a certain value in a cell is found:

Code:
``````Range("H2").Select
Do Until IsEmpty(ActiveCell)
If ActiveCell.Text = "SS" Then
ActiveCell.EntireRow.Copy
End If
Worksheets("Sheet1").Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Worksheets("DATA").Select
ActiveCell.Offset(1, 0).Select
Loop``````

It works to a certain extent but it pastes ten of each row it finds into Sheet 1. Could someone tell me where i'm going wrong?

Cheers
D

### Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Maybe this is what you want:
Code:
``````Dim i as Long
i = 2
With Sheets("DATA")
Do Until IsEmpty(.Range("H" & i")
If .Range("H" & i) = "SS" Then
.Rows(i).Copy
Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row.Offset(1,0).Pastespecial xlPasteValues
End If
i = i + 1
Loop``````

Hi Jack,

It looks like its what I need but i'm getting a compile error on

Code:
``Do Until IsEmpty(.Range("H" & i")``

Sorry i'm a bit new at this.

D

Hi guys,

So i've managed to fix the first problem, but am now having problems with this line:

Code:
``Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row.Offset(1, 0).PasteSpecial xlPasteValues``

I'm getting run-time error 424 object required, any idea what this means?

Thanks
D

Hi Guys,

I've managed to solve the previous problem however I feel that the code is a bit long and there is a quicker way to write what i'm trying to do, here is the current code as it stands which works fine:

Code:
``````'Dim i As Long
'i = 2
'With Sheets("DATA")
'  Do Until IsEmpty(.Range("H" & i))
'    If .Range("H" & i) = "SS" Then
'       .Rows(i).Copy
'       Sheets("SS").Range("A" & Rows.Count).End(xlUp).Rows.Offset(1, 0).PasteSpecial xlPasteValues
'
'    ElseIf .Range("H" & i) = "HW" Then
'        .Rows(i).Copy
'        Sheets("HW").Range("A" & Rows.Count).End(xlUp).Rows.Offset(1, 0).PasteSpecial xlPasteValues
'
'    ElseIf .Range("H" & i) = "JC" Then
'        .Rows(i).Copy
'        Sheets("JC").Range("A" & Rows.Count).End(xlUp).Rows.Offset(1, 0).PasteSpecial xlPasteValues
'
'    ElseIf .Range("H" & i) = "OA" Then
'        .Rows(i).Copy
'        Sheets("OA").Range("A" & Rows.Count).End(xlUp).Rows.Offset(1, 0).PasteSpecial xlPasteValues
'
'    ElseIf .Range("H" & i) = "MM" Then
'        .Rows(i).Copy
'        Sheets("MM").Range("A" & Rows.Count).End(xlUp).Rows.Offset(1, 0).PasteSpecial xlPasteValues
'
'    ElseIf .Range("H" & i) = "LS" Then
'        .Rows(i).Copy
'        Sheets("LS").Range("A" & Rows.Count).End(xlUp).Rows.Offset(1, 0).PasteSpecial xlPasteValues
'
'    ElseIf .Range("H" & i) = "JM" Then
'        .Rows(i).Copy
'        Sheets("JM").Range("A" & Rows.Count).End(xlUp).Rows.Offset(1, 0).PasteSpecial xlPasteValues
'
' End If
' i = i + 1
' Loop

'End With``````

Now to make it more scaleable I was trying to use an array which is this:

Code:
``````Dim users As Variant
users = Array("SS", "HW", "JC", "OA", "LS", "JM")
With Sheets("DATA")
For intCounter = LBound(users) To UBound(users)
Dim i As Long
i = 2
Do Until IsEmpty(.Range("H" & i))

.Range("H" & i) = " & users(intCounter) & "
.Rows(i).Copy
Sheets(users(intCounter)).Range("A" & Rows.Count).End(xlUp).Rows.Offset(1, 0).PasteSpecial xlPasteValues

Loop

i = i + 1
Next
End With``````

It doesn't quite behave how I want it to. It doesn't stop it just continuously loops through all the names overwriting anything on the first sheet (SS) and replacing the rows. Could anyone point out where I am going wrong?

Cheers
D

Last edited:

Replies
4
Views
477
Replies
18
Views
388
Replies
3
Views
144
Replies
4
Views
240
Replies
3
Views
455

1,196,044
Messages
6,013,063
Members
441,747
Latest member
darkman77

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

### Which adblocker are you using?

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

### Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back