Excel2000マクロ_ブック名に一貫性が無くて既に開いている物の間のコピー等

何方か、回答をお願いします。
（A.xlsのAAAシート）（B.xlsのBBBシート）この２つ間のセル値をコピーしたい
のですが（共にブック名シート名に一貫性は無しで、既に開いています。）
マクロ付.xlsに下記のマクロを書いてA.xlsのAAAシートがアクティブの時にマクロを
実行してtwwにAAAシートをセット出来たのですが、Bk1にB.xlsのBBBシートをセット出来ません。
Application.Waitで止めている間にアクティブシートを変えようとしましたが駄目
Application.Dialogs(xlDialogWorkbookUnhide).Showでも駄目でした。
何方か、マクロ実行中のアクティブシート変更方法を教えて下さい。
又、この様なブック名に一貫性が無くて既に開いている物の間のコピー等はどの様に
するのか参考になる物が有れば教えて下さい。

Sub コピー()

Dim Bk1 As Worksheet
Dim tww As Worksheet

Set tww = ActiveWorkbook.Sheets(1)

'ここが分かりません

Set Bk1 = ActiveWorkbook.Sheets(1)

'-------1個目
tww.Range("D10").Value = Bk1.Range("H9").Value

Set Bk1 = Nothing: Set tww = Nothing

End Sub

No.1 回答者： n-jun 回答日時： 2008/01/10 19:37

Sub　try()

　Dim　wb　As　Workbook
　
　For　Each　wb　In　Workbooks
　　　　　If　wb.Name　=　ThisWorkbook.Name　Then
　　　　　　　　MsgBox　"このブックだよ　"　&　wb.Name
　　　　　Else
　　　　　　　　MsgBox　"違うブックだよ　"　&　wb.Name
　　　　　End　If
　Next
End　Sub
開いているブックのうち自Bookかそうでないかは、
こんな感じでわかるかな？
その判定結果で変数へのセットを変えてみては？

この回答へのお礼

n-jun様、回答ありがとう御座います。
なるほど、全てのブックをYES,NOで判別するのですね。
今度、確認したいと思います。

お礼日時：2008/01/11 16:18

No.2 ベストアンサー 回答者： lark_0925 回答日時： 2008/01/10 20:20

マクロ付.xlsの標準モジュールではなく、

ThisWorkbookのモジュールに
'=============================================================
Option Explicit
Private sht1 As Worksheet
Private WithEvents app As Application
Sub main()
　　If ActiveSheet.Type = xlWorksheet Then
　　　Set app = Application
　　　Set sht1 = Application.ActiveSheet
　　　Application.StatusBar = "データをやり取りするシートをアクティブにしてください"
　　　End If
End Sub
'============================================================
Private Sub app_WorkbookActivate(ByVal Wb As Workbook)
　　If Wb.Sheets(1).Type = xlWorksheet Then
　　　sht1.Cells(1, 1).Value = 1
　　　Wb.Sheets(1).Cells(2, 1).Value = sht1.Cells(1, 1).Value
　　　Application.StatusBar = False
　　　End If
　　Set app = Nothing
End Sub

として、データ交換する最初のシートをアクティブにしてThisworkbook.mainを実行してください。

次に適当なブックをアクティブにしてください。
最初にアクティブになっていたシートのＡ１に1が設定され、
選択したブックの最左端シートのセルＡ2に
最初にアクティブになっていたシートのＡ１の値がコピーされます。

一例です。参考にしてください。

この回答への補足

lark_0925様名前を間違ってお礼を書いてしまいました。
すみませんでした。

補足日時：2008/01/11 16:20

この回答へのお礼

n-jun様、回答ありがとう御座います。
今度、確認したいと思います。

お礼日時：2008/01/11 16:19

No.3 回答者： Wendy02 回答日時： 2008/01/10 23:48

こんばんは。

以下のようなコードを間に入れればよいと思います。
もちろん、自分のマクロのあるブックは、ThisWorkbook ですね。

Sub Test()
　　Dim obj As Object
　　Dim oBook As Workbook
　　On Error Resume Next
　　Set obj = Application.InputBox("目的先のブックのシートのセルを選択してください。", Type:=8)
　　If obj Is Nothing Then
　　　　Exit Sub
　　End If
　　On Error GoTo 0
　　If StrComp(TypeName(obj), "Range") = 0 Then
　　　　Set oBook = obj.Parent.Parent　'ここでブックオブジェクト取得
　　　　If oBook Is ThisWorkbook Then
　　　　　　MsgBox "それは、目的先のブックではありません。", 48
　　　　Else
　　　　　　MsgBox oBook.Name
　　　　End If
　　End If
End Sub

この回答への補足

Wendy02様もし良ければ、時間がある時で結構ですので補足回答をお願いします。
Application.InputBoxを使うとどうも初めのActivateWorkbook以外のブックを
選択出来ません。（開いているファイルは、コピー元.xls-コピー先.xls-マクロ記入.xls
等の3個です。）
後、質問には1個のセル値のみコピーをしていますが実際は複数で位置もばらばらのセルを
コピーをしています。
問題はlark_0925様の回答で解決しましたが、良ければ回答をお願いします。

補足日時：2008/01/11 18:46

この回答へのお礼

Wendy02様、お久しぶりです。
毎回の回答ありがとう御座います。
今度、確認したいと思います。

お礼日時：2008/01/11 16:26

No.4 回答者： Wendy02 回答日時： 2008/01/11 23:51

こんばんは。

元のコードは、マクロのあるブックと、コピー元が一致しているという想定です。

>（開いているファイルは、コピー元.xls-コピー先.xls-マクロ記入.xls等の3個です。）

しかし、それは、ThisWorkbook を端にActiveBook に書き換えたら済むことだと思います。

>質問には1個のセル値のみコピーをしていますが実際は複数で位置もばらばらのセルをコピーをしています。

なお、これ自体は、配列に入れておけば、一括で管理できると思います。

'-------------------------------------------
Sub Test1()
　　Dim obj As Object
　　Dim oBook As Workbook
　　On Error Resume Next
　　Set obj = Application.InputBox("目的先のブックのシートのセルを選択してください。" & vbCrLf & _
　　　 "コピー元： " & ActiveWorkbook.Name, Type:=8)
　　If obj Is Nothing Then
　　　　Exit Sub
　　End If
　　On Error GoTo 0
　　If StrComp(TypeName(obj), "Range") = 0 Then
　　　　Set oBook = obj.Parent.Parent　
　　　　If oBook Is ActiveWorkbook Then
　　　　　　MsgBox "それは、目的先のブックではありません。", 48
　　　　Else
　　　　　　MsgBox "コピー元: " & ActiveWorkbook.Name & vbCrLf & _
　　　　　　"コピー先: " & oBook.Name
　　　　End If
　　End If
End Sub

'以下は、二つ選択する方法です。
'以下の場合は、どちらかというとUserForm のほうが管理しやすいです。
'-------------------------------------------
Sub Test2()
　　Dim obj As Object
　　Dim oBook As Workbook
　　Dim dstBook As Workbook
　　On Error Resume Next
　　Set obj = Application.InputBox("コピー元のブックのシートのセルを選択してください。", Type:=8)
　　If obj Is Nothing Then
　　　　Exit Sub
　　End If
　　On Error GoTo 0
　　If StrComp(TypeName(obj), "Range") = 0 Then
　　　　Set oBook = obj.Parent.Parent　'ここでブックオブジェクト取得
　　　　If oBook Is ThisWorkbook Then
　　　　　　MsgBox "それは、目的先のブックではありません。", 48
　　　　End If
　　End If
　　Set obj = Application.InputBox("コピー先のブックのシートのセルを選択してください。" & vbCrLf & _
　　　　"コピー元: " & oBook.Name, Type:=8)
　　If obj Is Nothing Then
　　　　Exit Sub
　　End If
　　On Error GoTo 0
　　If StrComp(TypeName(obj), "Range") = 0 Then
　　　　Set dstBook = obj.Parent.Parent　'ここでブックオブジェクト取得
　　　　If dstBook Is ThisWorkbook Or dstBook Is oBook Then
　　　　　　MsgBox "それは、目的先のブックではありません。", 48
　　　　End If
　　End If
　　
　　If MsgBox("コピー元: " & oBook.Name & vbCrLf & _
　　　　　　　"コピー先: " & dstBook.Name & vbCrLf & _
　　　　　　　"よろしいですか？", vbOKCancel) = vbOK Then
　　 'コピー実行
　　End If
End Sub

この回答へのお礼

Wendy02様、毎回の回答ありがとう御座います。
無事完成することが出来ました。

お礼日時：2008/01/14 15:16