他のブックでマクロを実行するには？

質問

以下のマクロを実行すると同一ブック内の他のシートに入力
されますが、これを他のブックのシートに入力されるように
するには、具体的にどのようにすればいいのでしょうか？
ご教授ください。

----------------------------------------------------------------
Sub 入力()
Dim LastRow As Long
With Worksheets("sheet2")
LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value
.Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value
.Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value
.Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value
.Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value
.Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value

End With

End Sub

回答No.2

Wendy02

こんばんは。

書き換えると、こんな感じですね。
写すほうのブックは開いておいてください。

'----------------------------------

Sub 入力2()
　　Dim i As Long
　　Dim j As Long
　　Dim Sh1 As Worksheet
　　Dim Sh2 As Worksheet

　　On Error GoTo ErrHandler
　　'以下のように書き換えます。
　　Set Sh1 = ThisWorkbook.Worksheets("sheet1")
　　Set Sh2 = Workbooks("TestBook1.xls").Worksheets("sheet2")

　　j = Sh2.Cells(Rows.Count, 2).End(xlUp).Row + 1

　　For i = 1 To 6
　　　　Sh2.Cells(j, i + 1).Value = Sh1.Cells((i - 1) * 2 + 1, 2).Value
　　Next i
ErrHandler:
　　If Err.Number > 0 Then
　　　　MsgBox Err.Number & " : ブックが開いていないか、シートが見つかりません。", 48
　　End If
　　Set Sh1 = Nothing
　　Set Sh2 = Nothing

End Sub

回答No.1

imogasi

>すると同一ブック内の他のシートに入力されますが
sheet2を指定しているから、Sheet2にセットされるだけで、Sheet2をActivateしているときは「他の」シートといえますか？紛らわしい。
Sheet2からSheet2に代入するコードも質問のパターンです。左辺は
Sheet2で指定しますが。
ーー
Sub 入力()
Dim wk1 As Workbook
Dim wk2 As Workbook
Set wk1 = ActiveWorkbook
Set wk2 = Workbooks.Open("C:\Documents and Settings\XXX\My Documents\BBBBBBB.xls")
'--
Dim LastRow As Long
With wk1.Worksheets("sheet2")
LastRow = wk1.Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("B" & LastRow).Value = wk2.Worksheets("sheet1").Range("B1").Value
.Range("C" & LastRow).Value = wk2.Worksheets("sheet1").Range("B3").Value
.Range("D" & LastRow).Value = wk2.Worksheets("sheet1").Range("B5").Value
.Range("E" & LastRow).Value = wk2.Worksheets("sheet1").Range("B7").Value

End With
End Sub
--
新規作成などのブックに上記を標準モジュールに張り付け、実行します。
読み込んだブックのSheet1における、コードで指定して書いたセルから読んで、新規ブックの指定セルに値を代入します。
--
ブックーシートーRangeという階層構造を丁寧に（上位オブジェクトの指定で、省略するとXXと看做すという、看做しの機能に頼って、略さず）書けば良いだけです。

お礼

早速回答頂きましてありがとうございます。
試してみたいと思います。