find text and copy selected rows from text and loop
 

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

find text and copy selected rows from text and loop
 

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" wrote:

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

find text and copy selected rows from text and loop
 

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

"Mike H" wrote:

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" wrote:

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

find text and copy selected rows from text and loop
 

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



"Mike H" wrote:

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" wrote:

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