Sub ventiler()
Dim t, i&, j&, n&
t = Sheets("data").Range("a1").CurrentRegion
ReDim r(1 To UBound(t) * UBound(t, 2) / 2 + 1, 1 To 3)
For j = 1 To UBound(t, 2) Step 2
For i = 2 To UBound(t)
If t(i, j) <> "" Then
n = n + 1: r(n, 1) = t(1, j)
r(n, 2) = t(i, j): r(n, 3) = t(i, j + 1)
End If
Next i
Next j
With Sheets("Res").Range("a1")
.Clear
.Resize(UBound(r), UBound(r, 2)) = r
End With
End Sub