find text and copy selected rows from text and loop

[bluewatermist]

Hi

I'm need your expert help. In a worksheet I need to find the word
"Filename" in column B, then cut rows until the next "Filename" word. I need
this looping to start from the 2nd "Filename" word.

Upon highlighting rows I need to cut selected rows and add this to a new
worksheet. This needs to be done until all "Filename" words have been
searched.

I'm hoping this makes senses and that someone out there can help me.

Many thanks
Frederic

 

[Mike H]

Hi,

Put this in a 'General' module and run it. It assumes the source data are in
Sheet1 so change to suit

Sub Lime()
Dim LastRow As Long, count As Long, x As Long
Dim StartRow As Long, EndRow As Long
Dim MyRange As Range
Dim MySheet As String
MySheet = "Sheet1" ' Change as required
LastRow = Sheets(MySheet).Cells(Cells.Rows.count, "B").End(xlUp).Row
x = 1
Do
If Sheets(MySheet).Cells(x, 2) = "Filename" Then
count = count + 1
End If
x = x + 1
Loop Until count = 2
Set MyRange = Sheets(MySheet).Range("B" & x - 1 & ":B" & LastRow)
count = 0
For Each c In MyRange
If c.Value = "Filename" And count = 0 Then
StartRow = c.Row
count = count + 1
ElseIf c.Value = "Filename" And count > 0 Then
EndRow = c.Row - 1
count = 1
Sheets(MySheet).Range("B" & StartRow & ":B" & EndRow).EntireRow.Copy
Worksheets.Add
ActiveSheet.Range("A1").PasteSpecial
StartRow = c.Row
End If
Next
End Sub


Mike

 

[bluewatermist]

Hi Mike

I'm getting a run time error '9' subscrip of range for "LastRow"

LastRow = Sheets(MySheet).Cells(Cells.Rows.count, "B").End(xlUp).Row

Regards
Frederic

 

[bluewatermist]

Hi Mike

I'm getting a run time error '9', subscript out of range on "LastRow"
LastRow = Sheets(MySheet).Cells(Cells.Rows.count, "B").End(xlUp).Row

Many thanks
Frederic

 

[bluewatermist]

Hi Mike

Sorry for the two same entries, I was having computer problems and couldn't
see the post at all. Having said all that, please disregard this issue as i
have resolved it.

The other issue is that if there are only two "filename" words in the same
sheet, it doesn't seperate them into another sheet.

Many thanks
Frederic