VBA 縦横変換

質問

CSVファイルでC,D,E列を6行毎に別シートに貼り付けたいのですが、VBAがわからず困ってます。
A行とＢ行はすべて同じでC,D,E行が異なります
6行目のC,D,Eを1行目のＴ列まで置き換えたら　2行目で同じ事の繰り返しになります。
このデータが300行程度あり、毎週発生して置き換えが必要になります
どなたか、お教え頂けますでしょうか？

A B C D E
1 A(株) 田中 HE-1 ABC 伝票A
2 A(株) 田中 HE-2 DEF 伝票B
3 A(株) 田中 HE-3 GHI 伝票C
4 A(株) 田中 HE-4 JKL 伝票D
5 A(株) 田中 HE-5 MNO 伝票E
6 A(株) 田中 HE-6 PQR 伝票F
・
・
↓の用に置き換え

A B C D E F G H J K L・・・・
1 A(株) 田中 HE-1 ABC 伝票A HE-2 DEF 伝票B HE-3 GHI 伝票C・・・
2 A(株) 田中 HE-7 STU 伝票G HE-8 VWX 伝票H HE-9 YZa 伝票I・・・

説明がわかりづらくて申し訳ありません。
なにとぞよろしくお願い致します。

回答No.2

imogasi · ベストアンサー

CSVデータはエクセルシートに読み込まれているとして、はじめる。
例データ
A(株) 田中 HE-1 ABC 伝票A
A(株) 田中 HE-2 DEF 伝票B
A(株) 田中 HE-3 GHI 伝票C
A(株) 田中 HE-4 JKL 伝票D
A(株) 田中 HE-5 MNO 伝票E
A(株) 田中 HE-6 PQR 伝票F
A(株) 田中 HE-7 ABC2 伝票G
A(株) 田中 HE-8 DEF2 伝票H
A(株) 田中 HE-9 GHI2 伝票I
A(株) 田中 HE-10 JKL2 伝票J
A(株) 田中 HE-11 MNO2 伝票K
A(株) 田中 HE-12 PQR2 伝票L
A(株) 田中 HE-13 ABC3 伝票M
A(株) 田中 HE-14 DEF3 伝票N
A(株) 田中 HE-15 GHI3 伝票P
A(株) 田中 HE-16 JKL3 伝票Q
A(株) 田中 HE-17 MNO3 伝票R
A(株) 田中 HE-18 PQR3 伝票S
A(株) 田中 HE-19 ABC4 伝票T
A(株) 田中 HE-20 DEF4 伝票U
ーー
コード　標準モジュールに
Sub test02()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1") 'Sheet1を使う。原データ
Set sh2 = Worksheets("Sheet2") 'Sheet1を使う。結果データ
k = 2 '結果データは２行目から
j = 3 '繰り返し列の最初は３列目から
d = sh1.Range("A65536").End(xlUp).Row '原データ最終行
MsgBox d
For i = 2 To d
'--会社と氏名　２列
If j Mod 3 = 0 Then
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(i, "B")
End If
'---繰返し部分データ　３列
sh2.Cells(k, j) = sh1.Cells(i, "C")
sh2.Cells(k, j + 1) = sh1.Cells(i, "D")
sh2.Cells(k, j + 2) = sh1.Cells(i, "E")
j = j + 3 '次は３列右から
If j > 20 Then '=3*6+2　6回分済んだら
k = k + 1 '次行に書き出し
j = 3 '繰り返しデータ列の最初は3列目から
End If
Next i
End Sub
ーー
結果
A(株) 田中 HE-1 ABC 伝票A HE-2 DEF 伝票B HE-3・・・
A(株) 田中 HE-7 ABC2 伝票G HE-8 DEF2 伝票H HE-9・・・
A(株) 田中 HE-13 ABC3 伝票M HE-14 DEF3 伝票N HE-15・・・
A(株) 田中 HE-19 ABC4 伝票T HE-20 DEF4 伝票U ・・・
右の方の列は掲載省略。
ーーー
ただSheet1のセルデータをSheet2の何処の列へ代入するかだけの簡単な問題。
質問者は変数　ｊ、K　のようなポインター的な使い方などが経験ないのかな。

お礼

返信遅くなり　申し訳ありません
回答ありがとうございます。
見事　できました！！！

が、私の質問ミスでまだ出来上がってないんです。。
VBAはマクロ操作した物をVBEで開いて見て、書き換えて・・っていう程度しか
した事がないので、変数の使い方がよくわかりません。

回答No.1

hallo-2007

通りがかりです。
元データが　Sheet1
書き換え先が　Sheet2　というシートだとして
Sub ボタン1_Click()
GYOU = 2
RETU = 1
With Sheets("Sheet2")
For i = 2 To Sheets("Sheet1").UsedRange.Rows.Count
.Range(.Cells(GYOU, RETU), .Cells(GYOU, RETU + 5)).Value = Range(Cells(i, 1), Cells(i, 6)).Value
RETU = RETU + 5
If RETU > 6 * 5 Then
RETU = 1
GYOU = GYOU + 1
End If
Next
End With
End Sub

一例です。