Option Explicit: Option Base 1
Sub Essai()
Dim n&: n = Cells(Rows.Count, 1).End(3).Row
If n = 1 And IsEmpty([A1]) Then Exit Sub
Dim T1, T2, i&, j&, k&
T1 = [A1].Resize(n, 4): ReDim T2(2 * n, 3)
For i = 1 To n
For j = 3 To 4
k = k + 1
If k Mod 2 = 1 Then
T2(k, 2) = "HI": T2(k, 1) = T1(i, 1)
Else
T2(k, 2) = "LO"
End If
T2(k, 3) = T1(i, j)
Next j
Next i
Application.ScreenUpdating = 0: Columns.ClearContents
[A1].Resize(2 * n, 3) = T2
End Sub