modif de macro affichant 2 cellules en 1

[Mécano]

Bonsoir le forum.

J'ai un petit souci sur une macro que m'a aimablement remis un membre actif de ce forum, concernant l'affichage d'équipes participant à un concours.

Les 2 équipes sont affichées sur la feuille TIRAGE dans une seule cellule sous cette forme les "!" sont les bordures de colonnes)


! jean - paul !
! pierre - jacques !
! rené - yves !

et ainsi de suite.

Comment svp modifier la macro dont je vous joins le code afin que l'affichage soit fait ainsi?:

!jean ! (libre) ! (libre) !paul !
!pierre ! (libre) ! (libre) !jacues !
!rené ! (libre) ! (libre) !yves !

etc.

Option Explicit
Sub Tirage()
Sheets("TOURNOI").Select
Range("A1").Select
Dim Visiteur As Byte
Dim Maligne As Integer
Dim tabEq() As String
Dim i As Integer, j As Integer
Dim NbEq As Variant, TotCell As Integer
Dim ZoneOrig As Range, ZoneDest As Range, Départ As Range
Dim Cellule As Object
Dim ModeCalcul As Long
Dim N As Variant
Dim C As Variant
ModeCalcul = Application.Calculation
Maligne = 0
NbEq = [NBParts]
'Alerte en cas d'erreur
If NbEq = "" Or NbEq < 3 Then
MsgBox "INSCRIS AU MOINS 3 EQUIPES AVANT DE LANCER LE TIRAGE !", vbInformation, "ATTENTION !! ARRET PROCEDURE"
Exit Sub
End If
' Mise en mémoire dans un tableau des noms d'équipes
ReDim tabEq(NbEq)
For i = 1 To NbEq
tabEq(i) = Range("NomsParts").Cells(i, 1)
Next i
' Effacement des anciennes données
Range("A1:AY2100").ClearContents
Range(Range("BF65536").End(xlUp), Range("BF4")).ClearContents
' Première boucle pour le nombre de journées
For i = 1 To NbEq - 1
Visiteur = 0
If i = NbEq - 1 Then
Maligne = Maligne + 1
ElseIf i > 1 Then
Maligne = Maligne + 2
End If
' Seconde boucle pour le nombre d'équipes à placer
For j = i + 1 To NbEq
Maligne = Maligne + 1
If j = NbEq And i <> NbEq - 1 Then Maligne = Maligne + i - 1
If Visiteur = 0 Then
Cells(Maligne, 1) = tabEq(i) & " - " & tabEq(j)
Visiteur = 1
Else
Cells(Maligne, 1) = tabEq(i) & " - " & tabEq(j)
Visiteur = 0
End If
Next j
Next i
' Mise en tableau du tirage
TotCell = NbEq * (NbEq - 1) / 2
Set ZoneOrig = Range(Cells(1, 1), Cells(TotCell, 1))
Set ZoneDest = Range(Cells(1, 3), Cells(NbEq, NbEq - 1 + 2))
i = 0
For Each Cellule In ZoneDest
i = i + 1
Cellule = ZoneOrig(i)
Next Cellule
' Effacement des cellules vides
ZoneDest.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Cells(1, 3).Select
Set ZoneOrig = Nothing
Set ZoneDest = Nothing
Application.Calculation = ModeCalcul

'Mise en colonne des résultats
For Each N In Range("Res")
If N <> "" Then
For Each C In Range(N, N.Offset(25, 0)).Cells
If C <> "" Then
C.Copy
Range("BF65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End If
Next C
End If
Next N
Range("BE1").Select
End Sub
Function Visité(Cellule As Range)
Visité = Val(Left(Cellule, InStr(1, Cellule, "-") - 2))
End Function
Function Visiteur(Cellule As Range)
Dim MyPos As Byte
MyPos = Len(Cellule) - InStr(1, Cellule, "-") - 1
Visiteur = Val(Right(Cellule, MyPos))
End Function

D'autre part, j'ai vu une boucle pour le nombre de journées de tournoi, et mes tournois ne sont pas concernés par cela.
Je n'ai pas osé modifier la macro, ne connaissant pas le vba, est il possible de simplifier le code?

C'est un fichier destiné à des tournois de fléchettes, mais adaptable à d'autres utilisations. Aussi, si des personnes sont interessées, me le faire savoir par mail.

Je vous remercie beaucoup d'avance et vous souhaite une bonne nuit.

Mécano.