Finding column & row headers for each showing of specific text in a table of data

Hi

Try this version

Sub Test()
For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
    For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
        If WorksheetFunction.CountIf(Sheets("Out").Columns(1), Cells(N, M).Value) = 0 Then
            Sheets("Out").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Cells(N, M).Value
        End If
        TargetRow = Sheets(2).Columns(1).Find(Cells(N, M), , xlValues, xlWhole).Row
        Sheets("Out").Cells(TargetRow, Columns.Count).End(xlToLeft).Offset(0, 1) = "'" & Cells(1, M) & Cells(N, 1)
    Next M
Next N

'Tidy up
MaxNumber = 30
Sheets("Out").Activate
For N = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    Do While Cells(N, Columns.Count).End(xlToLeft).Column > MaxNumber + 1
        Rows(N + 1).Insert
        Cells(N + 1, 1) = Cells(N, 1)
        If (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber > 0 Then
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        Else
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        End If
    Loop

Next N

End Sub