Originally Posted by
Charlize
This will do it. It's because you putted a Start in A1. First time looking when using Find will skip A1.[vba]Option Explicit
Option Compare Text
Sub StartEnd()
'starting range
Dim rng As Range
'store lookup results
Dim result, result2
'workbook that we use
Dim current As Workbook
'sheet to copy to
Dim sht As Worksheet
'range to copy to
Dim rng2 As Range
Set current = ActiveWorkbook
Set sht = current.Worksheets("Result")
current.Activate
Set rng = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
'if destination A1 <> empty
If sht.Range("A1") <> "" Then
Set rng2 = sht.Range("A" & sht.Range("A" & Rows.Count).End(xlUp).Row + 1)
Else
Set rng2 = sht.Range("A1")
End If
'Because find function will skip A1 when starting
'we have to check it by using an if construction
If Range("A1").Value = "Start" Then
Set result = Range("A1")
Set result2 = rng.Find("End", LookIn:=xlValues)
Range(Cells(result.Row, 1), Cells(result2.Row, 1)).Resize(, 3).Copy rng2
Set rng = Range(Cells(result2.Row, result2.Column), _
Range("A" & Range("A" & Rows.Count).End(xlUp).Row))
End If
Do
'if destination A1 <> empty
If sht.Range("A1") <> "" Then
Set rng2 = sht.Range("A" & sht.Range("A" & Rows.Count).End(xlUp).Row + 1)
Else
Set rng2 = sht.Range("A1")
End If
With rng
Set result = .Find("Start", LookIn:=xlValues)
'if start is found, we look for End
'else exit the loop to avoid errors when searching for End
If Not result Is Nothing Then
Set result2 = .Find("End", LookIn:=xlValues)
Else
Exit Do
End If
End With
'resize the range to be copied from 1 to 3 columns
Range(Cells(result.Row, 1), Cells(result2.Row, 1)).Resize(, 3).Copy rng2
Set rng = Range(Cells(result2.Row, result2.Column), _
Range("A" & Range("A" & Rows.Count).End(xlUp).Row))
'if rowno of result2 (End) < total number of rows, we check again on
'start value
Loop While result2.Row < Range("A" & Rows.Count).End(xlUp).Row
End Sub
[/vba]