Option Explicit
Sub test()
Dim x, a, b(), i As Long, j As Long, pos
x = Array("Service 1", "Service 2", "Service 3")
With Sheets("Feuil1").Cells(1).CurrentRegion
a = .Value
ReDim b(1 To .Rows.Count, 1 To .Columns.Count)
For i = 1 To UBound(a, 2)
b(1, i) = a(1, i)
Next
For i = 2 To UBound(a, 1)
For j = 1 To 3
b(i, j) = a(i, j)
Next
For j = 4 To UBound(a, 2)
If a(i, j) <> "" Then
pos = Application.Match(a(i, j), x, 0)
b(i, pos + 3) = a(i, j)
End If
Next
Next
With .Offset(, .Columns.Count + 1).Resize(UBound(b, 1), UBound(b, 2))
.CurrentRegion.Clear
.Value = b
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.BorderAround ColorIndex:=3, Weight:=xlThin
With .Borders(xlInsideVertical)
.Weight = xlThin
.ColorIndex = 3
End With
With .Borders(xlInsideHorizontal)
.Weight = xlThin
.ColorIndex = 3
End With
With .Rows(1)
.Interior.ColorIndex = 6
.HorizontalAlignment = xlCenter
End With
End With
End With
End Sub