Sub test()
    Dim a, b, i As Long, ii As Long, n As Long
    a = Cells(1).CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 3)
    For i = 1 To UBound(a, 1)
        For ii = 3 To UBound(a, 2)
            If a(i, ii) <> "" Then
                n = n + 1: b(n, 1) = a(i, 1)
                b(n, 2) = a(i, 2): b(n, 3) = a(i, ii)
            End If
    Next ii, i
    Sheets.Add.Cells(1).Resize(n, 3).Value = b
End Sub