[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『飛び飛びにデータを貼りたい VBA』（みみ）
初めまして。
教えて下さい。
シート1、シート2の値を、シート3に貼り付けたいです。
シート1, 2の構造は同じで、値だけ違います。
シート1
A B C D E F No. 項目 種別 4月 5月 6月 1 a A 1.2 0.2 1.3 2 b B 1.1 0.4 1.2 3 c C 1.3 0.1 1.1
シート2
A B C D E F No. 項目 種別 4月 5月 6月 1 a A 1.0 0.5 0.8 2 b B 1.0 0.3 1.2 3 c C 2.0 0.2 0.2
シート3（完成図）
シート1 シート2 シート1 シート2 シート1 シート2 No. 項目 種別 4月 4月 5月 5月 6月 6月 1 a A 1.2 1.0 0.2 0.5 1.3 0.8 2 b B 1.1 1.0 0.4 0.3 1.2 1.2 3 c C 1.3 2.0 0.1 0.2 1.1 0.2
一気に貼り付けたいですが、貼り付け先が飛び飛びの為に、良いやり方が思いつきません。
（マクロ勉強し始めたばかりで、試行錯誤中です）
下記を繰り返せば、何とかできそうな所まで来ましたが、1列ずつの対応となり、実際は横に長い表なので現実的ではありません。
ご教授頂ければ幸いです。
Sub コピーペースト()
Dim LastRow As Long
LastRow = Worksheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Worksheets("sheet1").Range("D2:D" & LastRow).Copy
Worksheets("sheet3").Cells(3, 4).PasteSpecial xlPasteAll
Worksheets("sheet2").Range("D2:D" & LastRow).Copy
Worksheets("sheet3").Cells(3, 5).PasteSpecial xlPasteAll
End Sub
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
Sheet2の月毎のデータを、(Sheet1をコピーした)Sheet3の後ろにまとめてコピーペイストして、 列方向にソートするとよいのではないですか？ 月名は、日付データであることが前提ですが。 （γ） 2022/10/29(土) 12:38:45
貼り付け先のイメージは、下記です。
4月 4月 空白列 5月 5月 空白列 ・・・12月 12月 空白列 →→ 以降、様々な計算列が10列位続く。 （みみ） 2022/10/29(土) 12:52:07
フーム。 じゃあ二つのシートの10列の計算式は どのように配置するのですか？ それも説明しないといけませんね。正しく参照ができますか？ （γ） 2022/10/29(土) 13:11:01
（みみ） 2022/10/29(土) 13:36:39
【初心者向けエクセルVBA】For～Next文で簡潔にプログラムを書く
https://tonari-it.com/excel-vba-for-next/
（hatena） 2022/10/29(土) 14:10:41
（γ） 2022/10/29(土) 14:18:02
Sub コピーペースト()
Dim LastRow As Long
Dim k As Long
Dim j As Long
LastRow = Worksheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
k = 4
For j = 4 To 6
With Worksheets("sheet1")
.Range(.Cells(2, j), .Cells(LastRow, j)).Copy
Worksheets("sheet3").Cells(3, k + 0).PasteSpecial xlPasteAll
k = k + 2
End With
Next
k = 5
For j = 4 To 6
With Worksheets("sheet2")
.Range(.Cells(2, j), .Cells(LastRow, j)).Copy
Worksheets("sheet3").Cells(3, k + 0).PasteSpecial xlPasteAll
k = k + 2
End With
Next
End Sub
（みみ） 2022/10/29(土) 16:40:51
こんばんは、VBAの練習をさせてください。^^;
値で転記なので、Copyメソッドを使用しないでやってみました。 シート名を、後で変更できるようにするのが好みなので、インデックス を使用もしてみました。
Sub Sample_Copy()
Dim ws(1 To 3) As Worksheet
Dim month(4 To 6) As Variant
Dim i As Long, n As Long, q As Long, LastRow As Long
Set ws(1) = Sheets(1)
Set ws(2) = Sheets(2)
Set ws(3) = Sheets(3)
LastRow = ws(1).Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To 2
For q = 4 To 6
month(q) = ws(i).Range(ws(i).Cells(2, q), ws(i).Cells(LastRow, q))
ws(3).Range(ws(3).Cells(3, q + n), ws(3).Cells(LastRow + 1, q + n)).Offset(, q - 4) = month(q)
Next q
n = n + 1
Next i
End Sub
書き方の良し悪しは、ここの大先輩方に教授していただいてください。 お邪魔しました (o_ _)o ﾍﾟｺ
（あみな） 2022/10/29(土) 17:52:45
この使い方↓も、とても勉強になります。
Dim month(4 To 6) As Variant
ありがとうございます！！
（みみ） 2022/10/29(土) 18:50:07
いろいろ方法はあると思います。 作る人の好みにもよるでしょう。 とりあえずご参考までに作ってみました。
Public Sub Sample()
Dim rngs(1 To 3) As Range
Set rngs(1) = Worksheets(1).Cells(1).CurrentRegion
Set rngs(1) = Intersect(rngs(1), rngs(1).Offset(1, 3))
Set rngs(2) = Worksheets(2).Cells(1).CurrentRegion
Set rngs(2) = Intersect(rngs(2), rngs(2).Offset(1, 3))
Set rngs(3) = Worksheets(3).Cells(3, 4).Resize(rngs(1).Rows.Count, rngs(1).Columns.Count * 3)
Dim i As Long
For i = 1 To rngs(1).Columns.Count
rngs(3).Columns(i * 3 - 2).Value = rngs(1).Columns(i).Value
rngs(3).Columns(i * 3 - 1).Value = rngs(2).Columns(i).Value
Next
End Sub
コピー元のワークシートが２つならループしなくてもいいかなと思います。 多くなるならループしてもいいでしょう。
（hatena） 2022/10/30(日) 07:38:24
皆様、ありがとうございました！
（みみ） 2022/10/30(日) 08:28:35
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.