VBAで他のシートの特定の列を検索・コピーし、貼り付ける。

質問

お世話になります。
VBA初心者です、よろしくお願いいたします。
掲題にありますとおり、他のシートの特定の列を検索(抽出?)しアクティブになっているシートの特定の列に貼り付ける作業を自動で行わせたいと思っております。複数ある行の中から必要な行だけを抽出して、貼り付けるのでフォーマットを整えると思っていただければ結構です。具体的には、
[Sheet1]のデータ↓( | ←は罫線と思ってください。列の順番は毎回A→Zの順番とは限りませんが、記載内容は同じです。)
A | B | C | D | E … | Z
1 | 2 | 3 | 4 | 5 … |26
a | b | c | d | e … | z
1a| 2b| 3c| 4d| 5e… |26z
これらのデータから、特定の必要な列を選んで[Sheet2]に貼り付けを自動で行わせたいのです↓。
[Sheet2]B,G,A,W,O,Iのデータのみ必要な場合
B | G | A | W | O | I
2 | 7 | 1 | 23| 15| 9
b | g | a | w | o | i
2b| 7g| 1a|23w|15o| 9i

行数は最大で500行を超えます。HLOOKUPを各セルに書き込んで置けばよいのですが、ドッラグでは式が正しく書き込めなくて。。。
"=HLOOKUP(A1,Sheet1!A:Z,2,0)"←"A1"はA2,A3,A4となるのですが"2"がずっと2のままなので。

[Sheet1]の特定の行のコピー&ペーストなのですが、[Sheet2]の貼り付け先が1行目からではないので、何かしらの工夫が必要だと思うのですが。。。
たとえば
Columns("B:B").Select
Selection.Copy
Sheets("Sheet2").Select
Cells(2, 1).Paste
こう言う事って出来ませんよね？

私の意は伝わりましたでしょうか？なにとぞよろしくお願いいたします。

回答No.3

fumufumu_2006 · ベストアンサー

こんなのではどうでしょうか？

Sub sample()
'初期設定（コピー元とコピー先のシート、コピーする列を設定）
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim copyColumns As String
Set srcSheet = Sheets("Sheet1")
Set dstSheet = Sheets("Sheet2")
copyColumns = "B,G,A,W,O,I"
'
Dim srcRowTop As Long
Dim srcRowBottom As Long
Dim dstRowTop As Long
Dim dstColumnLeft As Integer
Dim cols() As String
Dim i As Integer
'コピー元の最初と最後の行を取得（有効なデータ行は、A列には必ずデータがあるとします）
srcRowTop = 1
srcRowBottom = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row 'A列の最後のデータの行
If (srcRowBottom = 1) And (srcSheet.Cells(1, 1) = "") Then '最後の行が1行目で、実は1行目にデータが無い場合
Exit Sub 'コピー元データなし
End If
'コピー先の最初の行を設定
dstRowTop = 10 'C10の10
dstColumnLeft = 3 'C10のC(=3)
'コピーする列名を配列へ取得
cols = Split(copyColumns, ",")
'コピー開始
For i = 0 To UBound(cols)
srcSheet.Range(cols(i) & srcRowTop & ":" & cols(i) & srcRowBottom).Copy Destination:=dstSheet.Cells(dstRowTop, i + dstColumnLeft)
Next
End Sub

ちなみに、コピー先が変わったら
'コピー先の最初の行を設定
dstRowTop = 10 'C10の10
dstColumnLeft = 3 'C10のC(=3)
の部分を変更してください。

お礼

出来ました！C10から張り付いてくれました。
A,B,C…を貼り付ける部分のセルの色が白になってしまうので(コピー先はグレー、元は白)、「srcRowTop = 1」の1を2に変えてみたら1行目を含めずその下の部分をコピーして貼り付けてくれました。親切なDescriptionのおかげです。本当にありがとうございました。
また機会がございましたら、よろしくお願い申し上げます。