| 
    
     |  | お世話になります。 Ifで入れてみたのですが、どうもうまく貼り付けません。
 どう修正したらいいのでしょうか?
 何度も申し訳ございません。
 
 
 Sub オリジナル()
 Dim r As Range
 Dim j As Long, k As Long, i As Long
 Dim 名前 As String, 商品 As String
 Dim n As Long
 
 Set r = Worksheets("蒟蒻畑").Cells(1).CurrentRegion
 
 For j = 2 To r.Rows.Count
 名前 = r.Cells(j, 1).Value
 For k = 2 To r.Columns.Count
 商品 = r.Cells(1, k)
 For i = 1 To r.Cells(j, k)
 
 If n = 4 Then
 n = 1
 Worksheets("1").Cells(1 + 2, n).Value = 商品
 Worksheets("1").Cells(2 + 2, n).Value = 名前
 Else
 n = n + 1
 Worksheets("1").Cells(1, n).Value = 商品
 Worksheets("1").Cells(2, n).Value = 名前
 End If
 
 Next
 Next
 Next
 
 End Sub
 
 
 ▼マナ さん:
 >▼猫ママ さん:
 >
 >>投稿No.81343の続きで、横並びになったデータを3列毎に改行して別シートに
 >>貼り付けたいです。
 >
 >
 >以下の部分で、貼り付け先を調整するとよいです。
 >3列毎に改行なら、n=4になったら、n=1とすれば
 >列は、1→2→3→1→2→3…となります。
 >同時に、行も、それぞれ、+2するとよいです。
 >
 >>        n = n + 1
 >>        Worksheets("2").Cells(1, n).Value = 商品
 >>        Worksheets("2").Cells(2, n).Value = 名前
 >
 >
 >>
 >^
 
 
 |  |