Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
  • ベストアンサー

縦に並んだセルを別シートに横並びにコピーする方法

EXCELのシートAでH2セルからH95セル(94セル)まで数字が並んでいます。(途中の空白はなく、10セル埋まっている場合もあれば90セル埋まっている場合もあります。) その数値をシートBのセルに横12×縦7にてコピーをしたいです。 offset等駆使していますがうまくいきません。 どなたかご教示願います。 サンプル追加しました。

質問者が選んだベストアンサー

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率66% (1742/2615)
回答No.2

回答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)
回答No.4

訂正です。 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)
回答No.3

貼付のオプションで「行/列の入れ替え」にチェックを入れて貼り付けるってのはいかがでしょう。

  • kkkkkm
  • ベストアンサー率66% (1742/2615)
回答No.1

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

関連するQ&A

専門家に質問してみよう