[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入力した値を別BooKのシートに転記』（ちぃさん）
マクロを勉強の意味も含めてチャレンジしてみましたがやはりうまくできません。
教えてください。
BooK1のSheet1セルB4にVLOOKUPで検索した値があります。
この値をBook2のSheet1のB3からD3まで結合セルとBook3のSheet1の結合していないセルB2に転記したいのですが、やり方解らないので
試しで
BooK1のSheet1セルB4にVLOOKUPで検索した値をBook2のSheet1のB3からD3まで結合したセルに転記しようと
Sub prcCellCopyWorkbookToWorkbook()
Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4").Copy
Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").PasteSpecial
End Sub
記述してみましたが全く動かないです。
試しの段階で全くダメなのでどこが間違っているのかさっぱり解らないです。
ご教示いただけないでしょうか？
ご教示の際に必要な情報などありましたらそちらの方も教えていただければとおもいます。
宜しくおねがいします。
WindowsXP、Excel2003
Sub こんなかんじ()
Sheets("Sheet1").Select
Range("B4").Select
Selection.Copy
Workbooks.Open Filename:=book2
Sheets("Sheet1").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
end sub
(ozz)
またbook2を開けていて book１が閉じてるなら
Workbooks.Open Filenameでbook１をあけて
シート１のB4セルをアクティブにしてコピー
どっちにしても 格納フォルダー とかは 指定してません
いくつか、整理してもらえる？
１．まず、このマクロを実行するタイミングで、関連のブック（Book1.xlsmやBook2.xlsm)は開かれているのかどうか。 ２．いまくいかない とは、実行しても値が転記されない？ 意図したものとは異なる値が転記される？ それとも、エラーになる？エラーになるなら、そのエラーメッセージは？
ところで、転記するものが値だけなら、コピペではなく、以下のようにできる。
Sub 値のみの転記()
Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").Value = Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4").Value
End Sub
(ぶらっと)
＞Sub こんなかんじ()
Sheets("Sheet1").Select
Range("B4").Select
Selection.Copy
Workbooks.Open Filename:=book2
Sheets("Sheet1").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
end sub
私が未熟すぎて使いこなせてません。
このマクロコードをBooK1のSheet1のモジュールに入力に入力したのですが、もしかして入力する場所を間違っていますか？
＞１．まず、このマクロを実行するタイミングで、関連のブック（Book1.xlsmやBook2.xlsm)は開かれているのかどうか。
（Book1.xlsmやBook2.xlsm)は開いている状態です。今気づいたのですが拡張子が.xlsmになっていました。まさかと思い今、拡張子を.xlsに直しましたが反応しなかったです。
＞２．いまくいかない とは、実行しても値が転記されない？ 意図したものとは異なる値が転記される？
それとも、エラーになる？エラーになるなら、そのエラーメッセージは？ 実行しても値が転記されないです。エラーも何もなしです。VLOOKUPの値がダメなのかと思いBooK1のSheet1セルB4に数字の1を手打ちしましたがそれでも何も転記されなかったです。
＞ところで、転記するものが値だけなら、コピペではなく、以下のようにできる。
Sub 値のみの転記()
Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").Value = Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4").Value
End Sub
こちらのマクロコードも反応しません。やはり私が入力場所が間違っているのでしょうか？
このマクロコードをBooK1のSheet1のモジュールに入力に入力したのですが、もしかして私が入力する場所を間違っていますか？
シートモジュールでも、絶対にだめってことはないけど、通常は、標準モジュールに書く。 シートモジュールは、イベント処理など「特殊な用途」につかうモジュール。
さておき、「反応しない」とは、どういう状況なのかな？ マクロを動かしても、実行されない？ 具体的に、どのようにしてマクロを動かそうとしている？
いずれにしても、（ちぃさん） さんのアップしたコードも私がアップしたコードも動くよ、ちゃんと。 で、失礼ながら、(ozz)さんのコードは、（ちぃさん） さんのコードで、きちんとブック修飾、シート修飾を しているのに、シートのSelect、セルのSelect を行い、Selection を相手に処理している、あまり感心しないコード。 少なくとも、（ちぃさん）さんのコードを、そのように書き換える必要はないね。
(ぶらっと)
＞さておき、「反応しない」とは、どういう状況なのかな？
＞マクロを動かしても、実行されない？
＞具体的に、どのようにしてマクロを動かそうとしている？
Book1のSheet1セルB4のVLOOKUPで検索した値を別のBook2のSheet1B3からD3まで結合セル(数式バーの横のセル表示はB3となっていますので以後B3とします。）B3に転記なので
Book1のセルB3にデーターの入力規則でリスト範囲を設定し、VLOOKUPで一致した物がBook1のSheet1セルB4に表示させて、その表示をBook2のSheet1のB3に転記させようとしてます。
指摘のあったモジュールの件で書く場所を変えてみました。
正しいかは解らないのですが
1.Book1を開きSheet1を選択
2.Altキー+[F11]でVBEの画面表示
3.挿入→標準モジュールの順で標準モジュールに記述
4.保存
5.Book1を開いている状態でBook2を開く
6.Book1のセルB3項目を選択（今回は数字の"13"としています）
7.Book1のセルB4にVLOOKUPで一致した物が表示（今回は"bb"としています）
8.Book2のSheet1"B3"はやはり空白です。
すみません。
WindowsXP、Excel2003でしたが先ほどPCが突然動かなくなってしまったので私の都合になってしましますが問題なければWindows7、Excel2010に変更でもいいでしょうか？
横から失礼しますが、 そういえば 2003 だと xlsm のファイルは開けないですよね。で、2010で実行した場合、 手順 7 の後、「値のみの転記」のマクロを実行していますか？ (Mook)
＞手順 7 の後、「値のみの転記」のマクロを実行していますか？
はい。試してみました。
「値のみの転記」してみましたが転記しませんでした。
ぶらっとサンから
＞（ちぃさん） さんのアップしたコードも私がアップしたコードも動くよ、ちゃんと。
とのことでしたのでWindows7、Excel2010に変更後一旦、自分でアップしたコードの部分で拡張子も直し再入力してみましたがやはりダメでした。
Sub prcCellCopyWorkbookToWorkbook()
Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4").Copy
Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("B3").PasteSpecial
End Sub
Book2の方は拡張子が.xlsxに直しました。
・・・・どこがダメなのかまったくわかりません。
通常ファイルが無かったりしたら、コードが黄色くなって停止するのですが、 「転記しませんでした。」というのはエラーも発生しないのでしょうか。
Sub prcCellCopyWorkbookToWorkbook にカーソルを置いて、F8（ステップ実行）しても Copy、PasteSpecial の行に移動しませんか？ また EXCEL は複数起動していないでしょうか。 VBE から見たときに Book1.xlsm（自分自身）と Book2.xlsx は二つ見えていますか？ (Mook)
マクロは、以下のような方法で動く。（他にもいろいろあるけど） （ちぃさん）は、どの方法で起動している？
１．マクロ->マクロ で表示されるダイアログボックスの中から動かしたいマクロを選んで実行。 ２．シートにフォームツールのボタン等を配置し、それに動かしたいマクロをマクロ登録して、そのボタン等をクリック ３．シートにActiveXコントロール（コントールツールボックスのコントロール）を配置し、そのクリックなどで 動く。この場合、シートモジュールに特別な、(CommandButton1_Ckick 等）コードを書いておく。 ４．シートモジュールに、シート上の様々な動きをキャッチする特別なコード（Worksheet_Change 等）をかいておいて シート上でその動きがあったときに自動実行。 ５．マクロに、マクロショートカットキー（ a とか）を登録し Ctrlキーと、そのコード（a とか）を押して実行させる。
標準モジュールであれ、シートモジュールであれ、
Sub prcCellCopyWorkbookToWorkbook()
処理コード
End ub
と書いてあるだけでは、このマクロは動かないけど、そこは大丈夫かな？
(ぶらっと)
＞「転記しませんでした。」というのはエラーも発生しないのでしょうか。
エラーでコードが黄色くなって停止する表示は見たことありますが今回はないです。
＞Sub prcCellCopyWorkbookToWorkbook にカーソルを置いて、F8（ステップ実行）しても
＞Copy、PasteSpecial の行に移動しませんか？
Sub prcCellCopyWorkbookToWorkbook にカーソルを置いて、F8を押すと黄色くなり移動します。
＞VBE から見たときに Book1.xlsm（自分自身）と Book2.xlsx は二つ見えていますか？
これはモジュールのことでしょうか？
モジュールのことでしたら二つ見えてます。
＞４．シートモジュールに、シート上の様々な動きをキャッチする特別なコード（Worksheet_Change 等）を＞かいておいてシート上でその動きがあったときに自動実行。
私はこの方法です。
＞Sub prcCellCopyWorkbookToWorkbook()
処理コード
End ub
と書いてあるだけでは、このマクロは動かないけど、そこは大丈夫かな？
あ・・・なんかもの凄く気になる一言なんですが・・・
今、私は 標準モジュールにアップしているマクロコードしか書いてないです。
もしかしてなにか不足部分がありますか？
ありましたら教えてくだい。
たとえば、その B4 の VLOOKUP で参照している検索値のセル（入力されるセル）が G4 だったとする。 =VLOOKUP(G4,・・・・・)
・シートモジュールでも標準モジュールでもいいけど、prcCellCopyWorkbookToWorkbook は １）私がアップしたようなコードにする。 ２）そちらのコードの形であれば、
Sub prcCellCopyWorkbookToWorkbook()
Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4").Copy
Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
このように、Paste:=xlPasteValues を指定して、かつコピー状態をリセットするコードを追加。
・こうした上で、シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G4")) Is Nothing Then prcCellCopyWorkbookToWorkbook
End Sub
これを記述しておく。
これで、G4 に値が入れば自動実行される。
ところで、シートモジュールで、シート修飾をしなければ、そのシートと見なされるので どちらのコードであれ
Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4")
は
Range("B4")
だけの記述でいいよ。
(ぶらっと)
いけました。
動いたことに超感動。
で、すみません。
新たに問題が出てしまいました。
動いたのですが、エラーもました。
「実行エラー1004
この操作には、同じサイズの結合サイズが必要です。」
結合しているセルには転記するのは無理ですか？
あぁ、そうか。B3:D3が結合セルだったんだね。
じゃぁ、私がアップした形のコードを使って。
(ぶらっと)
我ながら情けないのですが・・・・
再びエラーです。
「コンパイルエラー
修正候補：ステートメントの最後」
＞じゃぁ、私がアップした形のコードを使って。
全てシートモジュールでも問題ないと思い全てシートモジュールに入力しています。
VLOOKUPで参照している検索値のセル（入力されるセル）はBooK1のSheet1セルB3にありますので
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then prcCellCopyWorkbookToWorkbook
End Sub
としてます。
必ず Paste:=xlPasteValuesと
Application.CutCopyMode = False
は必要と思い Paste:=xlPasteValues はスペースを空け
Workbooks("Book2......Paste:=xlPasteValues までは横一列で記述しています。
Sub 値のみの転記()
Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").Value = Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4").Value Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
どこか間違っているのでしょうか？
指摘いただきたいです。
おねがいいたします。
Paste:=xlPasteValues は PasteSpecial の引数なので、今回は不要です。 Copy もしていないので、そのあとの CutCopyMode も不要です。
元の prcCellCopyWorkbookToWorkbook は操作で言えば、 コピー ⇒ 形式を選択して貼り付け ですが、それに対してぶらっとさんが描かれたのは、値の代入なので
Sub 値のみの転記()
Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").Value = Range("B4").Value
End Sub
だけで必要十分なはずです（B3：結合セルは左上のセルを指定）。
もし私がこれを書くとしたら、こんな感じでしょうか。ファイルが開いていなければ 開いて処理をしています。 (Mook)
Sub 値のみの転記()
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Const Book2Name = "Book2.xlsx"
Dim wb2 As Workbook
'// Book2.xlsx があればセット。
On Error Resume Next
Set wb2 = Workbooks(Book2Name)
On Error GoTo 0
'// Book2.xlsx が開いていなければ
If wb2 Is Nothing Then
'// 場所が決まっているならフルパスで記述も可
'// 今回はBook1 と同じ場所にある場合かをチェック
If Dir(ThisWorkbook.Path & "\" & Book2Name) = "" Then
MsgBox "このブックの場所には " & Book2Name & " はありません。開いてからやり直してください。"
Exit Sub
End If
'// Book2.xlsx を開く
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & Book2Name)
ws1.Activate '// 開いたブックがアクティブになるので元に戻す。
End If
'// コピー元は Range("B4").Value でもOK なはず。
wb2.Worksheets("Sheet1").Range("B3").Value = ws1.Range("B4").Value
End Sub
Mookさん フォロー深謝。
To （ちぃさん）さん
ということです。私からもコメントしたように Book1.xlsmのSheet1は、このシートモジュールのシートなので
右辺は 単純に Range("B4").Value でＯＫ。
実行時に Book2.xlsm が開かれていない場合もあり得るなら Mookさんからでているように、開くコードもどうぞ。
(ぶらっと)
えっ Book2が閉じていても強制的に開かせることができるのですか？
驚きです。
で、まだ迷宮から出れていません。
ぶらっとサンにご教示いただいた方からなのですがいまだ解決できてません。
初めはエラー
「コンパイルエラー
Ifブロックに対応するEndIfがありません」
が出ていたので End If をつけてからエラーはでなくなったのですが、VLOOKUP で参照している検索値のセルB4に値が入ってもまた動かなくなりました。（泣）
エラーも出ないし初めとおなじ無反応です。
入力はシートモジュールに書いてます。
Sub 値のみの転記()
Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").Value = Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4")
Application = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then
End If
End Sub
Mookサンにご教示いただいた方もまんまコピーしましたが動きません。（泣）
こちらも初めはエラー
「コンパイルエラー
Ifブロックに対応するEndIfがありません」
が出ていたので End If をつけてからエラーはでなくなったのですが、VLOOKUP で参照している検索値のセルB4に値が入ってもまた動かなくなりました。（泣）状態はぶらっとサンにご教示いただいたコードと同じ反応でエラー無しの無反応です。
勝手ながらこちらも ぶらっとサン にご教示いただいた
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then
End If
End Sub
は必要ですよね？たぶん・・・
と思い
で、このような感じに記述してみましたが
Sub 値のみの転記()
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Const Book2Name = "Book2.xlsx"
Dim wb2 As Workbook
'// Book2.xlsx があればセット。
On Error Resume Next
Set wb2 = Workbooks(Book2Name)
On Error GoTo 0
'// Book2.xlsx が開いていなければ
If wb2 Is Nothing Then
'// 場所が決まっているならフルパスで記述も可
'// 今回はBook1 と同じ場所にある場合かをチェック
If Dir(ThisWorkbook.Path & "\" & Book2Name) = "" Then
MsgBox "このブックの場所には " & Book2Name & " はありません。開いてからやり直してください。"
Exit Sub
End If
'// Book2.xlsx を開く
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & Book2Name)
ws1.Activate '// 開いたブックがアクティブになるので元に戻す。
End If
'// コピー元は Range("B4").Value でもOK なはず。
wb2.Worksheets("Sheet1").Range("B3").Value = ws1.Range("B4").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then
End If
End Sub
ダメです。
どこがダメなのでしょうか？
聴くばかりで申し訳ないですが・・・
お助けください。
ぶらっとさんは、最初にこう書いていましたよね？
> Private Sub Worksheet_Change(ByVal Target As Range)
> If Not Intersect(Target, Range("G4")) Is Nothing Then prcCellCopyWorkbookToWorkbook
> End Sub
呼び出し側は
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then 値のみの転記
End Sub
もしくは
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then
値のみの転記
End If
End Sub
です。
マクロはプログラムなので、こんな感じ・・・ではなかなか動きません。
If 条件 Then
条件時に実行する内容
End If
は
If 条件 Then 条件時に実行する内容
とすると、End If を省略できます。下のサイトの最後の方。
http://msdn.microsoft.com/ja-jp/library/vstudio/752y8abs.aspx
できるだけ VBA の説明サイトを見た方が良いですが、今回の If に関する文法
に関しては、上記サイト（VB）でも VBA と同じ文法です。
変更する際は、まず文法を確認して、ネットや掲示板のコードを変更する際も、 まずは必要最低限、理解した範囲で少しずつ変更していった方が良いと思います。
セルアドレスだけ変えて動かしてみる。 それができたら、ファイル名だけ変えて動かしてみる。 というように。 (Mook)
Mookさん、重ね重ねのフォロー深謝です。 衝突したけどメモったので。
>Application = False
これは何かな？ コンパイルレベルのエラーになるよね？
それと
>Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").Value = Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B4")
でもいいけど、
Workbooks("Book2.xlsm").Worksheets("Sheet1").Range("B3").Value = Range("B4")
でいいよ。
で、本題だけど
>「コンパイルエラー Ifブロックに対応するEndIfがありません」 が出ていたので End If をつけてから
いやいや、そうじゃないよ。 アップしたコードは
If Not Intersect(Target, Range("B3")) Is Nothing Then prcCellCopyWorkbookToWorkbook
だったよね？ End If はいらない。
そちらのコード
If Not Intersect(Target, Range("B3")) Is Nothing Then
End If
これでは、条件が満たされても何もしないで End If 。 この形式で書くなら
If Not Intersect(Target, Range("B3")) Is Nothing Then
prcCellCopyWorkbookToWorkbook
End If
(ぶらっと)
＞ マクロはプログラムなので、こんな感じ・・・ではなかなか動きません。
たしかにそのとうりです。感覚ではダメですよね。
勉強になりました。
最後にこのマクロコードを仕上げたいのですが
当初は
Book1のSheet1のB4に表示した値をBook2のSheet1のB3とBook3のSheet1のB2に転記予定でしたので
ぶらっとサンからご教示いただいたマクロコードは
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then 値のみの転記
End Sub
Sub 値のみの転記()
Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("B3").Value = Range("B4")
Workbooks("Book3.xlsx").Worksheets("Sheet1").Range("B2").Value = Range("B4")
End Sub
と私が当初の希望していたとうりにしあがりました。
私の理解力が無いばかりに長々とすみませんでした。
本当にありがとうございました。
Mookサンからご教示いただいたマクロコードでbook3のSheet1のB2にも転記しようとするとあと何処の部分に何をプラスすればいいのでしょうか？
閉じているBookを強制で開くのはすごく便利なのでぜひ仕上げたいのです。
おんぶに抱っこで申し訳ないのですがご指導いただけないでしょうか？
何卒宜しくお願いいたします。
>おんぶに抱っこで申し訳ないのですが
Workbooks.Openを調べると解ると思うけど・・・
'// Book2.xlsx を開く
Const Book2Name = "Book2.xlsx"
Dim wb2 As Workbook
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & Book2Name)
wb2.Worksheets("Sheet1").Range("B3").Value = ws1.Range("B4").Value
↑の流れが理解（自分で調べて）できればいいのにな・・・
Book3.xlsx を開くだと
Const Book3Name = "Book3.xlsx"
Dim wb3 As Workbook
Set wb3 = Workbooks.Open(ThisWorkbook.Path & "\" & Book3Name)
wb3.Worksheets("Sheet1").Range("B3").Value = ws1.Range("B4").Value
何処が変化したか？？
'// Book2.xlsx があればセット。
等は同じような方法なので処理は省略しています・・・
(ROM人)
＞↑の流れが理解（自分で調べて）できればいいのにな・・・
＞何処が変化したか？？
申し訳ないです。
色々と他のページも開きながら少しづつでつがご教示いただいたマクロコードを所々さわってはエラーを出しの繰り返しでやっているのですが・・・
難しいです。
で、先ほどもしかしてBook2の Sub 値のみの転記2() の最初の部分からコピーし選択部分をBook2→Book3に変えてマクロを動かすとエラーはでなくなりました。
が、まだBook3が開かないです。
何がダメなのでしょうか？
すみません。
もう少し勉強させてください。
Sub 値のみの転記2()
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Const Book3Name = "Book3.xlsx"
Dim wb3 As Workbook
'// Book2.xlsx があればセット。
On Error Resume Next
Set wb3 = Workbooks(Book3Name)
On Error GoTo 0
'// Book2.xlsx が開いていなければ
If wb2 Is Nothing Then
'// 場所が決まっているならフルパスで記述も可
'// 今回はBook1 と同じ場所にある場合かをチェック
If Dir(ThisWorkbook.Path & "\" & Book3Name) = "" Then
MsgBox "このブックの場所には " & Book3Name & " はありません。開いてからやり直してください。"
Exit Sub
End If
'// Book2.xlsx を開く
Set wb3 = Workbooks.Open(ThisWorkbook.Path & "\" & Book3Name)
ws1.Activate '// 開いたブックがアクティブになるので元に戻す。
End If
'// コピー元は Range("B4").Value でもOK なはず。
wb3.Worksheets("Sheet1").Range("B3").Value = ws1.Range("B4").Value
End Sub
私がBook2の選択部分をBook3に変更しているものです。
違っている部分を指摘いただけないでしょうか？
何度もすみません。
>が、まだBook3が開かないです。
「開かない」ということを、どうやって確かめた？
このコードは、開かれていなければ（そのブックがマクロブックであるBook1.xlsmと同じフォルダに存在するかどうかを調べた上で） 開いて、【それが前面に出てしまうので】ws1.Activate '// 開いたブックがアクティブになるので元に戻す。 これで、改めてマクロブックであるBook1.xlsmを全面に出している。 なので、開かれていないように見えるけど、ちゃんと背面に開かれていると思うけど？
表示タブメニューの左の方のウィンドウの切り替えをクリックすると、このエクセルに読み込まれているブックがでてくる。 その中に Book3.xlsx は、本当にないのかな？
ところで、
If wb2 Is Nothing Then
と wb2 に値が入っているかどうかをチェックしているけど、値を入れているのは
Set wb3 = Workbooks(Book3Name) だから If wb3 Is Nothing Then としなきゃいけないね。
モジュールの先頭に Option Explicit と記述しておくことを強く推奨。 こうしておくと、宣言していない変数を使うとコンパイラーが叱ってくれる。 で、この記述は、ＶＢＥ画面のツール->オプション の 編集タブで 変数の宣言を強制する(R) にチェックを入れておくと 次回からモジュールが生成されれば自動的に付加される。
(ぶらっと)
ちょっと別のポイントで。
今回は、最初に、「prcCellCopyWorkbookToWorkbook」という完成されたプロシジャがあったので
Private Sub Worksheet_Change(ByVal Target As Range)
変更されたセルが、目的のセルだったら、prcCellCopyWorkbookToWorkbook を実行する。
End Sub
Sub prcCellCopyWorkbookToWorkbook()
実際の処理ロジック部分
End Fub
こんな構成で提示した。もちろん、こういう構成でも問題ない。 ただ「一般的には」Worksheet_Change だけの、以下のような構成にすることが多いね。
Private Sub Worksheet_Change(ByVal Target As Range)
If 変更されたセルが、目的のセルだったら、
実際の処理ロジックを、この場所に書いてしまう
End If
End Sub
または、
Private Sub Worksheet_Change(ByVal Target As Range)
If 変更されたセルが、目的のセルじゃなかったら終了。（Exit SUb）
実際の処理ロジックを、この場所に書いてしまう
End Sub
で、この形で、「開かれていなければ開いた上で処理を行う」コードにまとめると以下のようになる。
Private Sub Worksheet_Change(ByVal Target As Range)
Const Book2Name As String = "Book2.xlsx"
Const Book3Name As String = "Book3.xlsx"
Dim myPath As String
Dim wb2 As Workbook
Dim wb3 As Workbook
'B3 が変更されたのでなければ終了
If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False '処理中の画面の動きを見せない
myPath = ThisWorkbook.Path & "\" 'Book2.xlsxやBook3.xlsが保存されているフォルダ。仮に Book1.xlsmと同じフォルダにしてある。
'Book2が開かれていれば取り込み
On Error Resume Next
Set wb2 = Workbooks(Book2Name)
On Error GoTo 0
If wb2 Is Nothing Then 'もし開かれていなければ Nothing のまま
If Dir(myPath & Book2Name) = "" Then
MsgBox Book2Name & " がフォルダに存在しません" & vbLf & "処理を中断します"
Exit Sub
End If
'フォルダから開いて wb に格納
Set wb2 = Workbooks.Open(myPath & Book2Name)
End If
'Book3が開かれていれば取り込み
On Error Resume Next
Set wb3 = Workbooks(Book3Name)
On Error GoTo 0
If wb3 Is Nothing Then 'もし開かれていなければ Nothing のまま
If Dir(myPath & Book3Name) = "" Then
MsgBox Book3Name & " がフォルダに存在しません" & vbLf & "処理を中断します"
Exit Sub
End If
'フォルダから開いて wb に格納
Set wb3 = Workbooks.Open(myPath & Book3Name)
End If
'実際の処理コードをここにかいてしまう
wb2.Worksheets("Sheet1").Range("B3").Value = Range("B4").Value
wb3.Worksheets("Sheet1").Range("B2").Value = Range("B4").Value
'Book2やBook3がフォルダから読み込まれた場合、それが前面になっているので
'あらためてマクロブックを前面に出し、Book2やBook3を背面に隠す
ThisWorkbook.Activate
Application.ScreenUpdating = True '画面描画表示の再開（なくても自動的に再開されるけど）
End Sub
このままでもいいけど、Book2やBook3が開かれていなかった場合に開く部分が２つ登場していて しかも、同じようなコードになっているね。 ここを、外に、共通プロシジャとして切り出して、Worksheet_Change そのもののコードをスッキリさせる書き方もあるけど まずは、↑のようなコードの構えを身につければよろしいかと。
(ぶらっと)
参考までに共通部分を切り出したコード例。
Private Sub Worksheet_Change(ByVal Target As Range)
Const Book2Name As String = "Book2.xlsx"
Const Book3Name As String = "Book3.xlsx"
Dim myPath As String
Dim wb2 As Workbook
Dim wb3 As Workbook
'B3 が変更されたのでなければ終了
If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False '処理中の画面の動きを見せない
myPath = ThisWorkbook.path & "\" 'Book2.xlsxやBook3.xlsが保存されているフォルダ。仮に Book1.xlsmと同じフォルダにしてある。
Set wb2 = getBook(myPath, Book2Name)
If wb2 Is Nothing Then Exit Sub
Set wb3 = getBook(myPath, Book3Name)
If wb3 Is Nothing Then Exit Sub
'実際の処理コードをここにかいてしまう
wb2.Worksheets("Sheet1").Range("B3").Value = Range("B4").Value
wb3.Worksheets("Sheet1").Range("B2").Value = Range("B4").Value
'Book2やBook3がフォルダから読み込まれた場合、それが前面になっているので
'あらためてマクロブックを前面に出し、Book2やBook3を背面に隠す
ThisWorkbook.Activate
Application.ScreenUpdating = True '画面描画表示の再開（なくても自動的に再開されるけど）
End Sub
Private Function getBook(path As String, bookName As String) As Workbook
'指定のBookが開かれていれば取り込み
On Error Resume Next
Set getBook = Workbooks(bookName)
On Error GoTo 0
If getBook Is Nothing Then 'もし開かれていなければ Nothing のまま
If Dir(path & bookName) = "" Then
MsgBox bookName & " がフォルダに存在しません" & vbLf & "処理を中断します"
Exit Function
End If
'フォルダから開いて wb に格納
Set getBook = Workbooks.Open(path & bookName)
End If
End Function
(ぶらっと)
#書いている間に、ぶらっとさんが共通化の例も書かれていますが、一応アップしときます。
「ぶらっとさんの提示されたやり方を理解するのでいっぱいいっぱい」 という状態でしたら、以下のコメント１〜３はスキップしてください。 (Mook)
【コメント１】 今のまま進んでも良いのですけれど、本当にやりたいことに対して 今のやり方が最善でしょうか。
前の方でマクロの起動方法をぶらっとさんが説明されていますけれど、 今回の場合はセルの値が変わったとき、というよりはボタンなどで 処理を実行した方が良いように感じます。
目的としては、マクロのあるファイル（Book1）であるセルの値を 他のファイル（Book2、Book3、・・・）に転記したい（終わったら閉じたい） というようなことではないでしょうか。 その場合はシートイベント処理より、マクロのボタンやショートカット処理 にした方が良いように思います。 (どうもイベント処理が標準と考えているようなので・・・。)
【コメント２】 で、混乱させるようですけれど、ぶらっとさんが書かれている >外に、共通プロシジャとして切り出して、 というようにしたやり方です。
下記は値を変更後に手動でマクロを実行する例です。 Alt+F8 で「値を複数ファイルへ転記」を選んでください。
コードはシートモジュールでもいいですけれど、標準モジュールに置いてください。 参考：マクロってどこに書けばいいの？ ← 出来れば全体を一読することをお勧め http://officetanaka.net/excel/vba/beginner/10.htm
'//----------------------------------------------------------------------
Sub 値を複数ファイルへ転記()
'//----------------------------------------------------------------------
Dim 実行時アクティブシート As WorkSheet
Set 実行時アクティブシート = ActiveSheet
他ブックへ値転記 実行時アクティブシート.Range("B3"), ThisWorkbook.Path, "Book2.xlsx", "Sheet1", "B4"
他ブックへ値転記 実行時アクティブシート.Range("B3"), ThisWorkbook.Path, "Book3.xlsx", "Sheet1", "B4"
実行時アクティブシート.Activate
End Sub
'//----------------------------------------------------------------------
Sub 他ブックへ値転記(コピーセル As Range, コピー先フォルダ As String, コピー先ブック名 As String, コピー先シート名 As String, コピー先アドレス As String)
'//----------------------------------------------------------------------
MsgBox "処理を開始します！！" '// ★確認用：運用時には削除
Dim コピー先ブック As Workbook '// 「コピー先ブック名」は 文字列、 「コピー先ブック」 はブックを指す。
'// ファイルが既に開いていればセット。
On Error Resume Next
Set コピー先ブック = Workbooks(コピー先ブック名)
On Error GoTo 0
'// ファイルが開いていなければ
If コピー先ブック Is Nothing Then
If Dir(コピー先フォルダ & "\" & コピー先ブック名) = "" Then
MsgBox "指定ファイルは " & コピー先フォルダ & "\" & コピー先ブック名 & " に見つかりません！！！"
Exit Sub
End If
MsgBox コピー先ブック名 & "がなかったので開きます！！" '// ★確認用：運用時には削除
'// Book2.xlsx を開く
Set コピー先ブック = Workbooks.Open(コピー先フォルダ & "\" & コピー先ブック名)
End If
'// コピーの実行
コピー先ブック.Worksheets(コピー先シート名).Range(コピー先アドレス).Value = コピーセル.Value
'// 閉じる場合は以下の処理を実行。開きっぱなしにしたい場合は以下を削除
コピー先ブック.Save
コピー先ブック.Close
End Sub
【コメント３】
これを従来通りシートを変更したタイミングで実行した場合に、動作させたい場合は
シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then 値を複数ファイルへ転記
End Sub
としても良いですし、
参考：ワークシートのイベント
http://www.eurus.dti.ne.jp/yoneyama/Excel/vba/vba_event.html
ボタン実行したい場合は 2010 の場合は、 「開発」⇒「デザインモード」をオン 「開発」⇒「挿入」⇒「ActiveX コントロール」から「コマンドボタン」を選んでシート上に配置。 ボタンをダブルクリックして開いた場所に一行追加（真ん中の1行）
Private Sub CommandButton1_Click()
値を複数ファイルへ転記
End Sub
EXCEL に戻って、ボタンで右クリックし「プロパティ」を選択してCaption の項目を ボタンに表示したい文字列に変更してプロパティを閉じ、 「開発」⇒「デザインモード」をオフ
これで、ボタンをクリックするとマクロが動作します。
参考：コマンドボタンからマクロを実行する http://www4.synapse.ne.jp/yone/excel2010/excel2010_macro_command.html
連投失礼
あまり、いろんなことをいうと消化不良になってしまうかもしれないけど この処理で、必ず Book2.xlsx とBook3.xlsx を使うということであれば、 Book1.xlsmを開くときに自動的に Book2.xlsとBook3.xlsをマクロで開いてしまっておき Workbook_Changeでは「開かれている」Book2.xlsやBook3.xlsを相手にしたほうが コードもスッキリするし、効率もよくなる。そういった方法もあるね。
ただ、Workbook_Change でやろうとしていることは、Mookさんのコメント通り ボタン起動等にしたほうが、扱いやすいかもね。
(ぶらっと)
同じことを説明しているのですけれど、結構見た目やまとめ方が異なるので、 消化不良になりそうですね。 てゆーか、よく消化不良なります。 むしろ、よく消化不良なります。 逆に、よく消化不良なります。 < 参考サイトのパクリ
（私としては、個々の書き方が異なっていて面白いのですけれど）
まずはぶらっとさんのコメントに絞って、内容を理解する方がよさそうですね。 (Mook)
沢山の案、ご指導に感謝感謝です。
凄く勉強になります。
Mookサンの言うとうり消化不良になりそうです。
あ、私の場合はスペックが小さすぎて消化不良以前に中に入りきってないですが。
＞【コメント１】
＞【コメント２】
＞【コメント３】
こちら、Mookサン の言うとうり ぶらっとサン からご教示いただいたコードをもう少し理解してから挑戦していきます。
あ、でも私いまでもぜんぜん頭がついていけてないんですけどね。
ご教示いただいたマクロコードを私なりに理解しようと頑張っているのですがまだまだです。
もちろんこのアップしていただいたマクロコードをコピーだけして使っても身にならず応用ができないと思うので時間がかかると思うのですが、少しづつでも理解してと思っています。
ご教示いただいた内容に対して後日、また質問することがあると思いますが間違って理解していましたらその都度叱ってください。
マクロ超ド素人の私にここまで回答いただき、諄いですが感謝でいっぱいです。
回答いただいた皆様ありがとうございました。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.