Copy all rows between two values where the first value is variable

I want to loop and extract all the rows between two different words (For Example, 56050067 and 56050068) that repeat in a column. This code get me just the first range

Thank you for intance

My table like this:

56060067(1)

A

B

C

D

F

56060068(1')

J

H

I

K

L

56043556(1'')

T

Y

J

K

N

56060067(2)

O

P

Q

W

X

56060068(2')

56043556(2'')

Code:

Sub copy()

Dim rownum As Long

Dim colnum As Long

Dim startrow As Long

Dim endrow As Long

Dim lastrow As Long

Dim s As Range

Dim e As Range

rownum = 1

colnum = 1

lastrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row

With Sheets("Sheet1") 'or this can be any other sheet where you search

Set r = .Range("B:B").Find("56050067")

If Not r Is Nothing Then

Set e = .Range("B:B").Find("56050068", r).Offset(-1)

If Not e Is Nothing Then

.Range(r, e).EntireRow.copy Sheets("Sheet2").Range("A1") 'or to whatever sheet

End If

End If

End With

End Sub

Hello abbasab,

I don't know if I'm on the right way, but to test.

Dim rownum As Long
Dim colnum As Long
Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
Dim r As Range
Dim e As Range
rownum = 1
colnum = 1

    lastrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row

    With Sheets("Sheet1") 'or this can be any other sheet where you search

        Set r = .Range("B:B").Find("56050067")
            If Not r Is Nothing Then

        Set e = .Range("B:B").Find("56050068")
            If Not e Is Nothing Then
            .Range(r, e).EntireRow.copy Sheets("Sheet2").Range("A1") 'or to whatever sheet
            End If

            End If

    End With

End Sub

Same results :/

My table like this:

56060067(1)

A

B

C

D

F

56060068(1')

J

H

I

K

L

56043556(1'')

T

Y

J

K

N

56060067(2)

O

P

Q

W

X

56060068(2')

56043556(2'')

Can you attach an example file?

This is my excel file

9excel.xlsx (66.16 Ko)
Rechercher des sujets similaires à "copy all rows between two values where first value variable"