- ベストアンサー
縦に並んだセルを別シートに横並びにコピーする方法
- みんなの回答 (4)
- 専門家の回答
質問者が選んだベストアンサー
回答No.1は最終行を95行目と固定していますが、実際にデータのある最終行がいいのでしたら以下に変更してください。 Sub Test1() Dim i As Long, j As Long, k As Long Dim LastRow As Long LastRow = Sheets("シートA").Cells(Rows.Count, "H").End(xlUp).Row For i = 2 To LastRow Step 12 For j = 1 To 12 Sheets("シートB").Range("B15").Offset(k, j - 1).Value = Sheets("シートA").Cells(i + j - 1, "H").Value Next k = k + 1 Next End Sub もしくは Sub Test2() Dim i As Long, j As Long, k As Long Dim buf As Variant Dim LastRow As Long LastRow = Sheets("シートA").Cells(Rows.Count, "H").End(xlUp).Row j = 15 For i = 2 To LastRow Step 12 buf = Sheets("シートA").Cells(i, "H").Resize(12, 1).Value Sheets("シートB").Cells(j, "B").Resize(1, 12).Value = WorksheetFunction.Transpose(buf) j = j + 1 Next End Sub
その他の回答 (3)
- kkkkkm
- ベストアンサー率66% (1742/2615)
訂正です。 Test2の方は For i = 2 To LastRow Step 12 buf = Sheets("シートA").Cells(i, "H").Resize(12, 1).Value Sheets("シートB").Cells(j, "B").Resize(1, 12).Value = WorksheetFunction.Transpose(buf) j = j + 1 Next ではなくて以下で良かった For i = 2 To LastRow Step 12 Sheets("シートB").Cells(j, "B").Resize(1, 12).Value = WorksheetFunction.Transpose(Sheets("シートA").Cells(i, "H").Resize(12, 1).Value) j = j + 1 Next
- t_ohta
- ベストアンサー率38% (5288/13820)
貼付のオプションで「行/列の入れ替え」にチェックを入れて貼り付けるってのはいかがでしょう。
- kkkkkm
- ベストアンサー率66% (1742/2615)
VBAでいいのでしょうか 横12×縦7だと84セルになると思うのですが H2セルからH95セル(94セル)までを考えています。 Sub Test1() Dim i As Long, j As Long, k As Long For i = 2 To 95 Step 12 For j = 1 To 12 Sheets("シートB").Range("B15").Offset(k, j - 1).Value = Sheets("シートA").Cells(i + j - 1, "H").Value Next k = k + 1 Next End Sub もしくは Sub Test2() Dim i As Long, j As Long, k As Long Dim buf As Variant j = 15 For i = 2 To 95 Step 12 buf = Sheets("シートA").Cells(i, "H").Resize(12, 1).Value Sheets("シートB").Cells(j, "B").Resize(1, 12).Value = WorksheetFunction.Transpose(buf) j = j + 1 Next End Sub