セルに入れた値の行のブック転記

いつもお世話になっております。

別々のブックに転記するマクロを
色んなサイトを参考にして、使って問題なかったのですが、

特定のセルに数字を入れたら
その数字が入ってる行だけを別のブックに転記するマクロに変えようとしていますが
コードの構築がうまくいきません。

下記に図と転記マクロを記述します。

アドバイス及び何か別の方法があればご教授願えないでしょうか？

お手数ですがよろしくお願いいたします。

【大元管理簿】
　 A B C D E F G H I J K
1　見出し →→
2　　 ↓　　　　　　　　　　　　　　■
3　　 ↓
4　　 ↓
5　　 ↓
6　　 ● 　●　● 　●　●　●　●　●　●　●
　　　↓（入力データは下まで続きます）


行1～５までは項目の見出しで
B6からK6まで入力データがあります。(●部分）
以下、下まで続きます（100行くらい）

I2のセルに管理Noを入れて
その管理Noの行のデータを別ブックに転記







Sub 転記()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long
Dim i As Long
Set Sh1 = Workbooks("大元管理簿.xls").Worksheets(1)
Set Sh2 = Workbooks("転記先1.xls").Worksheets(1)

lastRow1 = Sh1.Range("B" & Rows.Count).End(xlUp).Row
If lastRow1 = 1 Then Exit Sub
With Sh2
For i = 6 To lastRow1

lastRow2 = .Range("B" & Rows.Count).End(xlUp).Row

.Range("B" & lastRow2 + 1 & ":K" & lastRow2 + 1).Value = Sh1.Range("B" & i & ":K" & i).Value
Next i
End With
End Sub

上記のコードがほかに
転記先1 転記先2 転記先3と転記先を別に変えて
それぞれボタンで切り分けています。

No.3 ベストアンサー 回答者： MarcoRossiItaly 回答日時： 2015/07/02 01:26

No.2 です。

ちょっと舌足らずな部分があったので、追加で説明します。すみません。

I2 セルの値が B 列で見付からなかった場合、マクロがエラーになってしまいます。それを防止するため、次のとおり書いてください。

on error resume next
i = worksheetfunction.match(Sh1.range("i2").value, Sh1.columns("b"), 0)
on error goto 0

この回答へのお礼

返答が遅くなり申し訳ありません。
無事、動作しました！！
ありがとうございました。

お礼日時：2015/07/04 08:20

No.2 回答者： MarcoRossiItaly 回答日時： 2015/07/02 00:59

要するに、Sh1 の I2 セルの値を同じシートの B 列から探し出し、見付けた 1 行のみを転記したいということですね。

その場合のコードの書き方ですね？

ループで全部の行を調べていってもいいですが、MATCH 関数で行番号を特定するのはいかがですか。

i = worksheetfunction.match(Sh1.range("i2").value, Sh1.columns("b"), 0)

で、該当の行番号 i が得られますね。1 行だけの処理だから、For ループは不要になりますね。

No.1 回答者： ExcelDevTool 回答日時： 2015/07/01 02:42

テンプレートに基づく転記なら下記をご参考ください。

この回答へのお礼

テンプレートで作る事も可能なのですね
参考させて頂きます　ありがとうございます。

お礼日時：2015/07/04 08:21