Hi
OK, see how this goes.
Sub aaa()
Range("A1").Select
dotrow = 1
xfnd = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Left(Cells(i, 1), 4) = "----" Then
If xfnd Then
Set outsh = Sheets(shtname)
Range(Cells(dotrow, 1), Cells(i, 1)).Copy Destination:=outsh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
dotrow = i
xfnd = False
End If
If InStr(1, Cells(i, 1), "Number:") > 0 Then
If InStr(1, Cells(i, 1), "Number: ") = 0 Then
shtname = Mid(Cells(i, 1), InStr(1, Cells(i, 1), "Number:") + 7, 5)
Else
shtname = Mid(Cells(i, 1), InStr(1, Cells(i, 1), "Number:") + 9, 5)
End If
End If
If (InStr(1, Cells(i, 1), "Message Type:") > 0 Or InStr(1, Cells(i, 1), "Status:") > 0) And Right(Cells(i, 1), 1) = "R" Then xfnd = True
Next i
End Sub
rylo
Bookmarks