# Copy set of rows if first 2 rows meet criteria until row changes value

#### Aldo88

##### New Member
Hi i'm new to macros and i need to create one where it copy range of rows if the first two rows meet criteria until the last row changes value.

For example
Copy rows if :
1st row = "h"
2nd row = "L"
3rd row= "D"

Copy rows until 3rd row changes back to "H"

 H L D D D D

Do not copy if after row "h" and "l" is not followed by an "D" row

 H L H L H L

#### Attachments

• 1594531420595.png
4 KB · Views: 4

### Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

#### mrshl9898

##### Well-known Member
Assuming your data starts in A1, try this:

*You just need to specify where the copied data is going (if anywhere)

VBA Code:
``````Sub copy()

Dim sht As Worksheet
Dim rownum As Long
Dim lastDrow As Long
Dim lastrow As Long

Set sht = ActiveSheet
rownum = 1
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

Do Until rownum = lastrow + 1
If Cells(rownum, 1) = "H" And Cells(rownum + 1, 1) = "L" And Cells(rownum + 2, 1) = "D" Then
lastDrow = rownum + 2
Do Until Cells(lastDrow + 1, 1) <> "D"
lastDrow = lastDrow + 1
Loop
Range(Cells(rownum, 1), Cells(lastDrow, 1)).copy '''SELECT WHERE TO COPY TO HERE
rownum = lastDrow
End If
rownum = rownum + 1
Loop

End Sub``````

#### Aldo88

##### New Member
I tried that but is only copying the last set

#### mrshl9898

##### Well-known Member
Try stepping through the code with F8. It is working, you're just seeing the end.

As mentioned this only copies data, you need to decide what to do with it after that happens as you haven't said anything about that part.

#### PureBluff

##### Board Regular
Hi @Aldo88

What did you specify as your destination at this point?

VBA Code:
``Range(Cells(rownum, 1), Cells(lastDrow, 1)).copy '''SELECT WHERE TO COPY TO HERE``

If it was something like:

VBA Code:
``Range(Cells(rownum, 1), Cells(lastDrow, 1)).copy Destination:=Worksheets("Output").Range("b2")``

Then, as youre in a loop, it'll reuse the destination on the next Header/Line/Detail trigger

Where do you want to put your data / what are you wanting to do with it once it's split out?

This would put the data on sheets "Output" fro row 2, with a spacer between each output

VBA Code:
``````Sub copy()

Dim sht As Worksheet
Dim rownum As Long
Dim lastDrow As Long
Dim lastrow As Long

Dim i As Long 'add this
Dim DstSht As Worksheet 'add this
Set DstSht = ThisWorkbook.Sheets("output") 'add this

i = 2 ' set this as your starting output row assuming you want it all on one sheet

Set sht = ActiveSheet
rownum = 1
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

Do Until rownum = lastrow + 1
If Cells(rownum, 1) = "H" And Cells(rownum + 1, 1) = "L" And Cells(rownum + 2, 1) = "D" Then
lastDrow = rownum + 2
Do Until Cells(lastDrow + 1, 1) <> "D"
lastDrow = lastDrow + 1
Loop
Range(Cells(rownum, 1), Cells(lastDrow, 1)).copy Destination:=DstSht.Range("b" & i) ' variable output destination row of i
rownum = lastDrow
End If
rownum = rownum + 1
i = DstSht.Cells(DstSht.Rows.Count, "B").End(xlUp).Row + 2 ' increment destination row by 2 rows at each Order Header change to give a blank row
Loop

End Sub``````

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

1,164,505
Messages
5,837,737
Members
430,514
Latest member
Stanislav546564

### 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.

### Which adblocker are you using?

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

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