Sub conc()
Dim tablo() As Variant
Dim TabFinal() As Variant
fin = Range("B" & Rows.Count).End(xlUp).Row - 1
'Range("A3").Resize(fin - 1, 4).Select
tablo = Range("A3").Resize(fin - 1, 4).Value
Nblig = UBound(tablo, 1)
NbCol = UBound(tablo, 2)
For i = LBound(tablo, 1) To UBound(tablo, 1)
If tablo(i, 1) <> "" Then nbLigResult = nbLigResult + 1
Next i
ReDim TabFinal(1 To nbLigResult, 1 To 4)
j = nbLigResult
For i = UBound(tablo, 1) To LBound(tablo, 1) Step -1
If tablo(i, 1) = "" Then
Pays = tablo(i, 2) & ";" & Pays
Else
Pays = tablo(i, 2) & ";" & Pays
TabFinal(j, 1) = tablo(i, 1)
TabFinal(j, 2) = Pays
TabFinal(j, 3) = tablo(i, 3)
TabFinal(j, 4) = tablo(i, 4)
Pays = ""
j = j - 1
End If
Next i
Range("H10").Resize(nbLigResult, 4) = TabFinal
End Sub