Sub Concat()
Dim w As Worksheet, P As Range, i&, j&
Application.ScreenUpdating = True
For Each w In Worksheets
Set P = w.[A1].CurrentRegion.Resize(, 13)
With w.[A38].Resize(P.Rows.Count, 13) 'à adapter
.Value = P.Value 'copie les valeurs
For i = 2 To .Rows.Count
If Len(.Cells(i, 2)) = 1 Then
.Cells(i - 1, 2) = .Cells(i - 1, 2) & .Cells(i, 2)
For j = i + 1 To .Rows.Count
.Rows(j - 1) = .Rows(j).Value 'décale vers le haut
Next j
.Rows(j - 1).ClearContents
End If
Next i
End With
Next w
End Sub