【エクセル】2つのブック間での値の貼り付けについて

質問

データ元と転記先の2つのファイルがあります。
データ元を【入】転記先【出】と便宜上します。
【入】a(6+i)の値を【出】H2:HG2の間で検索して
ない場合→転記を終了
ある場合→【入】H(6+i)の値を【出】(検索して引っ掛けた場所)(指定の値※6～170の間)へコピー
というマクロを組みたいのですが、まだ初心なのでよくわかりません。
ご教授をお願いいたします。

回答No.1

Raistlin · ベストアンサー

こんなので良いんでしょうか。
Excel97で作成しています。

※うまく行っていたらですが、行頭の字下げは全角スペースでしていますので、コピペ後に半角スペースに戻してください。

Sub MaP()
　　Dim SrcSht As Worksheet '転記元シート
　　Dim DatRng As Range '転記元データ範囲
　　Dim DstSht As Worksheet '転記先シート
　　Dim LblRng As Range '転記先ラベル範囲

　　Dim vBuf As Variant 'データ一時格納
　　Dim vRtn As Variant 'データ一時格納
　　Dim i As Long 'loop counter

　　Const lTrgtRw As Long = 7 '転記先行番号(仮置き)

　　Set SrcSht = Workbooks("入.xls").Sheets("Src") '転記元シートセット
　　Set DatRng = SrcSht.Range("A1:A1000") '転記元データ範囲セット
　　Set DstSht = Workbooks("出.xls").Sheets("Dst") '転記先シートセット
　　Set LblRng = DstSht.Range("H2:HG2") '転記先ラベル範囲セット

　　vBuf = DatRng '対象範囲内容を一度バッファにコピー

　　For i = 6 To 1000 'i行から1000行まで処理
　　　　On Error GoTo NGData
　　　　vRtn = Application.WorksheetFunction.Match(vBuf(i, 1), LblRng, 0) 'i行のデータがH2:HG2の何番目にあるか
　　　　If vRtn <> 0 Then DstSht.Cells(lTrgtRw, vRtn + 7).Value = SrcSht.Cells(i, 8) '転記先の対応列に転記元i行H列のデータを転記
　　Next i

Exit Sub
NGData: 'H2:HG2に含まれていないデータがあった時の処理
　　'今回は単に無視
　　vRtn = 0
　　Resume Next
End Sub