Excel VBA 別ブックを開かずに転記

質問

Excel2007のユーザーフォームについて教えてください。

ユーザーフォームを以下のように作成しました。

■テキストボックス6つ

テキストボックス2→件名
テキストボックス3→数
テキストボックス4→名前
テキストボックス5→備考1
テキストボックス6→備考2

■コマンドボタンが1と3の2つです。

コマンドボタン1→転記と印刷
コマンドボタン3→終了

■シートの構成
　sheet"作成と一覧"　
　1行目を以下の項目で使用しています。

　Ａ1→番号（テキストボックス1を表示）
　Ｂ1→件名（テキストボックス2を表示）
　Ｃ1→数（テキストボックス3を表示）

　sheet"印刷"

　Ａ1→番号（テキストボックス1を表示）
　Ａ2→件名（テキストボックス2を表示）
　Ｂ2→数（テキストボックス3を表示）
　Ａ3→名前（テキストボックス4を表示）
　Ａ4→備考１（テキストボックス5を表示）
　Ａ5→備考2（テキストボックス6を表示）

テキストボックスに入力した値を２つのシートにそれぞれ転記して、
シート"印刷"を2部印刷しています。

ここまで以下のコードで行いました。

Private Sub CommandButton1_Click()

'入力値を作成と一覧シートに転記

行 = ActiveCell.Row
列 = ActiveCell.Column
Cells(行, 列) = UserForm1.TextBox1.Value
Cells(行, 列 + 1) = UserForm1.TextBox2.Value
Cells(行, 列 + 2) = UserForm1.TextBox3.Value

'入力値を印刷シートにに転記
Worksheets("印刷").Range("A1") = UserForm1.TextBox1.Value
Worksheets("印刷").Range("A2") = UserForm1.TextBox2.Value
Worksheets("印刷").Range("B2") = UserForm1.TextBox3.Value
Worksheets("印刷").Range("A3") = UserForm1.TextBox4.Value
Worksheets("印刷").Range("A4") = UserForm1.TextBox5.Value
Worksheets("印刷").Range("A5") = UserForm1.TextBox6.Value

部数 = 2
Worksheets("印刷").PrintOut Copies:=部数, Collate:=True

UserForm1.TextBox1.SetFocus
Cells(行 + 1, 列).Select

End Sub

Private Sub CommandButton3_Click()
'終了ボタンで値をクリアしてウィンドウを閉じる
Dim Ctrl As Control

For Each Ctrl In Controls
If TypeName(Ctrl) = "TextBox" Then _
Ctrl.Value = ""
Next Ctrl
Unload Me
End Sub

教えて頂きたい事なのですが・・・

コマンドボタン1の入力値を作成と一覧シートに転記の所なのですが、
アクティブセルではなく、常にA列の最後の値の次の空白行に転記するようにしたい場合、
どのように書き換えればいいのでしょうか？

もう一点ですが、
別ブックにテキストボックス1から6が入力された一覧があります。
この別ブックを開かずに、
テキストボックス1に入力された番号を探して、
テキストボックス2から6に表示されるようにしたいのです。

うまく説明できないのですが・・・

別ブックの名前は"たちつ"

別ブックは、あいうサーバーの
かきくフォルダの中のさしすフォルダです。

ブック"たちつ"に"一覧"というシートがあります。

一覧のシートのD列の3行目以降には番号が入力されており、日々増えています。

テキストボックス1に入力された番号を、
一覧のD列から探し、
I列の値をテキストボックス2へ
K列の値をテキストボックス3へ
L列の値をテキストボックス4へ
M列の値をテキストボックス５へ
J列の値をテキストボックス6へ転記させたいのです。

同じブックの別シートを参照するときには
Application.VLookupで出来たのですが、
マクロの記録でやってみても、解決できませんでした。

コードをご覧いただいてお分かりの通り、
VBA超初心者です。
ネットを見ながら試行錯誤している状況です。

コードの間違い等あるかもしれませんが、
ご教示よろしくお願いいたします。

回答No.1

keithin

＞アクティブセルではなく、常にA列の最後の値の次の空白行に転記するようにしたい

「アクティブセル」になってる部分を修正するだけです。

変更前：
行 = ActiveCell.Row
列 = ActiveCell.Column

変更後：
行 = cells(rows.count, 1).end(xlup).offset(1).Row
列 = 1

＞もう一点ですが、

一つのご相談投稿では、１つのご質問内容で。
これはこちらのような質問相談掲示板での、ごく一般的なマナーなので覚えておいてください。

＞別ブックを開かずに、

まぁ、有体に言って初心者さんがよく陥りがちな、「無駄な努力」です。

＞テキストボックス1に入力された番号を探して、
＞テキストボックス2から6に表示されるようにしたい

private sub CommandButton2_Click()
　if textbox1 = "" then exit sub
　application.screenupdating = false
　range("A1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,6,FALSE)"
　range("B1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,8,FALSE)"
　range("C1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,9,FALSE)"
　range("D1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,10,FALSE)"
　range("E1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,7,FALSE)"
　textbox2 = range("A1").value
　textbox3 = range("B1").value
　textbox4 = range("C1").value
　textbox5 = range("D1").value
　textbox6 = range("E1").value
　range("A1:E1").clearcontents
　application.screenupdating = true
end sub

以上で、たちつブックを一切開かずに、安全に値を取ってくることができます。
なお、たちつブックの拡張子が不明なので、適切に修正してください。
IDがたちつブックに載ってなかったら、みたいなご相談の「想定外」については、適切に対処を考えてマクロに組み込んでください。

補足

ご教示ありがとうございます。
やってみたのですが、途中で別ブックを選択するウィンドウが出てしまって上手いように進みませんでした。
もう少し時間がかかりそうです。

取り急ぎご報告です。