Hello tauterouff,
The macro below has been added to the attached workbook. There is button "RUN" that will execute the macro and add the names in column "A".
Sub Macro1()
Dim Rng As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim Wks As Worksheet
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A2").CurrentRegion
Set Rng = Intersect(Rng, Rng.Offset(1, 4))
Set RngBeg = Rng.Cells(1, 1)
lastRow = Rng.Rows(Rng.Rows.Count).Row
Do
Set RngEnd = Rng.Find("Total for", RngBeg, xlValues, xlPart, xlByRows, xlNext, False, False, False)
If RngEnd Is Nothing Then Exit Do
i = InStr(1, RngEnd, ":")
RngBeg.Offset(0, -4).Resize(RngEnd.Row - RngBeg.Row, 1).Value = Mid(RngEnd, 11, i - 11)
If RngEnd.Row = lastRow Then Exit Do
Set RngBeg = RngEnd.Offset(1, 0)
Loop
End Sub
Bookmarks