VBA マクロを使って、コピー ソートしたいです

質問

画像でシート１の状態を、マクロでシート２のようにしたいです。
なにぶん初心者なので、効率のいいスクリプトがかけません。
よろしくお願いします。

条件としては
シート１には大きく分けて３つ表がありますが、実際は１０個あります。
１０個目までシート２上でデータがつながっている感じです。

B,G,L列の連番はデータの個数です。
シート１にあるように、表ごとに入ってる個数はばらつきます。

シート２ のA列はシート１のB,G,Lの２行目の番号が入っています。

回答No.1

keithin · ベストアンサー

淡々と順繰りに転記していくだけの作業です。

sub macro1()
　dim c as long
　dim r as long
　worksheets("Sheet1").select
　worksheets("Sheet2").range("A:E").clearcontents
　worksheets("Sheet2").range("A1:E1") = array("Gr","Num","V1","V2","V3")

　for c = 2 to 12 step 5
　　if cells(4, c + 1) <> "" then
　　　r = cells(65536, c + 1).end(xlup).row
　　　range(cells(4, c), cells(r, c + 3)).copy _
　　　　destination:=worksheets("Sheet2").range("B65536").end(xlup).offset(1)
　　　worksheets("Sheet2").range("A65536").end(xlup).offset(1).resize(r - 3, 1).value = cells(2, c).value
　　end if
　next c
end sub

補足

ありがとうございます。

A1に　array("Gr","Num","V1","V2","V3")
の内容が入っているのですが、こちらを削って、A1から結果が表示されるようにするにはどうすればいいでしょうか？

回答No.3

keithin

ん？
要らない行は削除します。

sub macro1r1()
　dim w1 as worksheet
　dim c as long
　dim r as long

　set w1 = worksheets("Sheet1")
　worksheets("Sheet2").select
　range("A:E").clearcontents

　for c = 2 to 12 step 5
　　if w1.cells(4, c + 1) <> "" then
　　　r = w1.cells(65536, c + 1).end(xlup).row - 3
　　　w1.cells(4, c).resize(r, 4).copy _
　　　　destination:=range("B65536").end(xlup).offset(1)
　　　range("A65536").end(xlup).offset(1).resize(r, 1).value = w1.cells(2, c).value
　　end if
　next c

　range("1:1").delete shift:=xlshiftup
end sub

などで。

回答No.2

Uyrjyyf6sd

私も基本はNo.1さんと変わりませんが、
一例となれば幸いです。

Sub Macro()

Dim i As Integer
Dim j As Integer
Dim lngEndRow As Long

j = 1 'Sheet2の1行目
For i = 3 To 13 Step 5 'Sheet1の3,8,13列目

lngEndRow = 0
lngEndRow = Sheets("Sheet1").Cells(65536, i).End(xlUp).Row
If lngEndRow >= 4 Then
Sheets("Sheet1").Range(Sheets("Sheet1").Cells(3, i), Sheets("Sheet1").Cells(lngEndRow, i + 2)).Copy
Sheets("Sheet2").Cells(j, 1).PasteSpecial
j = j + lngEndRow
End If

Next
End Sub

補足

タイトル1 文１
100 タイトル1 文１ タイトル2 文２
200 タイトル2 文２ タイトル3 文３
300 タイトル3 文３ タイトル4 文４
400 タイトル4 文４ タイトル1 文１
2 2 222 タイトル2 文２
2 3 333 タイトル3 文３
タイトル4 文４
111 タイトル1 文１ タイトル5 文５
222 タイトル2 文２ タイトル6 文６
333 タイトル3 文３ タイトル1 文１
444 タイトル4 文４ タイトル2 文２
555 タイトル5 文５ タイトル3 文３
666 タイトル6 文６

11 タイトル1 文１
22 タイトル2 文２
33 タイトル3 文３

ありがとうございます。
しかしためしたところ、結果が違うようでした。