the following macro seems to work on your file.
It works on the active sheet, so make sure that's the right one before you run it.
It puts the results on a new sheet:
Code:
Sub blah()
Dim DestnSht As Worksheet
Set SourceSht = ActiveSheet
Set DestnSht = Sheets.Add(After:=Sheets(Sheets.Count))
Set SourceRng = SourceSht.Range("A1").CurrentRegion
RowCount = SourceRng.Rows.Count
With DestnSht
.Cells(1, 1).Resize(RowCount).Value = SourceRng.Columns(1).Value
DestnColumn = 2
For c = 3 To SourceRng.Columns.Count
If UCase(Left(SourceRng.Columns(c).Cells(1), 4)) = "TEAM" Then
Set DestRng = .Cells(1, DestnColumn).Resize(RowCount)
DestRng.Value = SourceRng.Columns(c).Value
DestRng.TextToColumns Destination:=DestRng, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Semicolon:=True
DestnColumn = .UsedRange.Columns.Count + 1
End If
Next c
.UsedRange.EntireColumn.AutoFit
'optional for next loop to add person count in cell comment if missing or different:
For Each rw In .UsedRange.Offset(1, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count - 1).Rows
If rw.Cells(1).Offset(, -1).Value <> Application.CountA(rw) Then rw.Cells(1).Offset(, -1).AddComment CStr(Application.CountA(rw))
Next rw
End With
End Sub
Bookmarks