Maybe:

Sub alexxgalaxy()

Dim lr As Long
Dim rcell As Range
Dim i As Long

Application.ScreenUpdating = False

lr = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lr

    Range(Range("A" & i), Range("G" & i)).Copy
    
    Range("I" & Rows.Count).End(3)(2).PasteSpecial Transpose:=True
    
Next i

lr = Cells(Rows.Count, 9).End(xlUp).Row

For Each rcell In Range("I2:I" & lr)

    If Left(rcell, 4) = "Team" Then
    
        rcell.Cut rcell.Offset(, -1)
        
    End If
    
Next rcell

Range("I2").Delete xlUp

For Each rcell In Range("H2:H" & lr)

If rcell.Offset(, 1) <> "" Then

    rcell.Offset(1, 1).Select
    
        Do Until ActiveCell = ""
        
            ActiveCell.Offset(, -1).Value = rcell.Value
            
            ActiveCell.Offset(1).Select
            
        Loop
        
        End If

Next rcell

Range("H1:I" & lr).SpecialCells(xlCellTypeBlanks).Delete xlUp

Columns("A:G").Delete xlToLeft

Application.ScreenUpdating = True

End Sub