| 
    
     |  | 単純な処理なので、二重ループでシンプルに記述できると思います。 
 私なら、高速化も兼ねて、シート1のデータを配列に格納して、
 配列にレイアウト変更して出力し、
 それをシート2に書き出す、という方法をとりますね。
 
 Public Sub Test()
 Dim S1() As Variant, S2() As Variant
 Dim i As Long, j As Long, r As Long
 
 S1 = Sheet1.Range("A6").CurrentRegion.Value '表データを配列に格納
 ReDim S2(1 To (UBound(S1) - 1) * (UBound(S1, 2) - 3), 1 To 3) '出力用配列のサイズを確保
 
 For i = 2 To UBound(S1)
 For j = 2 To UBound(S1, 2)
 If S1(i, j) <> "" Then
 r = r + 1
 S2(r, 1) = S1(i, 1)
 S2(r, 2) = S1(1, j)
 S2(r, 3) = S1(i, j)
 End If
 Next
 Next
 
 Sheet2.Range("A1").Resize(r, 3).Value = S2
 End Sub
 
 
 |  |