『ファイルを検索してマクロ実行』（ミンミンゼミ） 同一フォルダ内に，Ａ，Ｂ，Ｃの３つのファイルがあります。 そこへ任意のＡ，Ｂ，Ｃ以外の名前のファイルを貼り付けます。 そこで，下記のようなＶＢＡコードをＡファイルに作りたいのですが できますでしょうか。 Ｓｕｂ 　フォルダ内に，Ａ，Ｂ，Ｃ以外のファイルが見つからなかったら 　マクロを実行しない 　Ａ，Ｂ，Ｃ以外のファイルが見つかったら，マクロを実行 　以下，マクロが続く（任意のファイルのデータをコピーする内容） Ｅｎｄ　Ｓｕｂ ---- こんな感じでどうでしょうか。(ROUGE)ちょっと修正。2008/11/19 11:15 '---- Sub Robust_Cicada() Dim ff, flg As Boolean flg = False With CreateObject("Scripting.FileSystemObject") For Each ff In .GetFolder(ThisWorkbook.Path).Files If InStr(1, ff.Name, ".xls") > 0 Then Select Case ff.Name Case "A.xls", "B.xls", "C.xls" Case Else flg = True Exit For End Select End If Next End With If flg Then Rem 続きのマクロを記載。 End If End Sub ---- どうもありがとうございます。 それで，いろいろ勉強して，下記のようなコードを作りました。 Sub Robust_Cicada() Dim ff, flg As Boolean flg = False With CreateObject("Scripting.FileSystemObject") For Each ff In .GetFolder(ThisWorkbook.Path).Files If InStr(1, ff.Name, ".xls") > 0 Then Select Case ff.Name Case "A.xls", "B.xls", "C.xls" Case Else flg = True Exit For End Select End If Next End With If flg Then Dim ws As Worksheet For Each ws In Sheets If ws.CodeName = "xyz" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True flg = True Exit For End If Next If Not flg Then Exit Sub マクロ実行 End If End Sub これは，Ａ，Ｂ，Ｃ以外のファイルが見つかったら，Codename　XYZ　のシートを削除した後， マクロを実行し，その後，もう一度同じマクロを実行しようとしても，XYZのシートが削除 されているから，同じマクロを実行できない，マクロは一度しか実行できないというものです。 でも，つなげ方が悪いんだと思いますが，マクロが何度でも実行できてしまいます。 これをうまくつなげて @Ａ，Ｂ，Ｃ以外のファイルが見つかったら，マクロを実行。 Aマクロは一度しか実行できず，再度マクロを実行しようとしても実行できない。 というふうにするにはどうしたらよろしいでしょうか。 素人ですみませんが，お願いします。 （ミンミンゼミ） ---- 順番変えたらどうですか。 一番最初にＡファイルのxyzシートが存在するかしないかチェックして、 なかったらマクロ終了。 xyzシートが存在してたら、Ａ，Ｂ，Ｃ以外のファイルがあるかをチェックして なかったらマクロ終了。 それだけで済む話に思えますが。 （通りすがり） ---- まず、続きのマクロについて、SheetsのParent Objectが明示されていませんので、その作業対象はActiveなBookになります。 A、B、C以外のBookに対して作業を行う必要があるのであれば、フラグを使うのではなく、Selectステートメント内 に収めてしまえばよいと思います。 下記はその例（検証はまったくしていません）。 (ROUGE) '---- Sub Robust_Cicada() Dim ff, wb As Workbook, ws As Worksheet With CreateObject("Scripting.FileSystemObject") For Each ff In .GetFolder(ThisWorkbook.Path).Files If InStr(1, ff.Name, ".xls") > 0 Then Select Case ff.Name Case "A.xls", "B.xls", "C.xls" Case Else On Error Resume Next Set wb = Workbooks(ff.Name) If wb Is Nothing Then Set wb = Workbooks.Open(ff.Path) End If For Each ws In wb.Sheets If ws.CodeName = "xyz" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True Exit For End If Next On Error GoTo 0 End Select End If Next End With End Sub ---- 上のコードで試してみましたが，うまくいきませんでした。 上のコードで下から２行目のEnd WithとEnd Subの間に実行するマクロを挿入するんですよね。 たとえば，セルの色を変えるマクロを入れたんですが， Ａ，Ｂ，Ｃ以外の名前のファイルを貼り付けなくても，マクロを実行すると セルの色が変わってしまうんですが。 もうちょっとでうまくいきそうなんですが，よろしくお願いします。 （ミンミンゼミ） ---- セルの色を変えるマクロというのは具体的にどのようなものでしょうか？ 上記例では、Selectステートメントに入れ込んでいますので、当初の仕様とは異なっております。 (ROUGE) ---- 下記のような感じですけど。 今回は試しにセルの色がオレンジになるようにしましたけど，本当は， Ａ，Ｂ，Ｃ以外の名前のファイルを貼り付けて，その内容をコピーするマクロ にする予定ですが。 Sub Robust_Cicada() Dim ff, wb As Workbook, ws As Worksheet With CreateObject("Scripting.FileSystemObject") For Each ff In .GetFolder(ThisWorkbook.Path).Files If InStr(1, ff.Name, ".xls") > 0 Then Select Case ff.Name Case "A.xls", "B.xls", "C.xls" Case Else On Error Resume Next Set wb = Workbooks(ff.Name) If wb Is Nothing Then Set wb = Workbooks.Open(ff.Path) End If For Each ws In wb.Sheets If ws.CodeName = "xyz" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True Exit For End If Next On Error GoTo 0 End Select End If Next End With Range("A1:A5").Select With Selection.Interior .ColorIndex = 46 .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With End Sub （ミンミンゼミ） ---- Parent Objectを明示することを考慮してください。 上記追加された部分では、セルしか指定されていません。 ''どのファイル''の''どのシート''のセルが対象なのかがこれでは不明確です。 まずは仕様をじっくり考えられてはいかがでしょうか。 (ROUGE) ---- ごぶさたしております。 上の例，私の説明不足のように思います。 続きのマクロは，Aのファイル内で作業を行います。 よって，以下の感じにしたいのですが @マクロはAファイル上に作り，Aファイルを開いて実行する。 Aフォルダ内にA，B，C以外のファイルがない場合は，マクロを実行しても動かない。 Bフォルダ内にA，B，C以外のファイル名のファイルを保存すると，マクロが実行される。 C続きのマクロはAファイル上で作業するもの。 D一度マクロを実行すると，再度実行できない。 それで，たとえば，続きのマクロとして，Aファイルのシート２のセルがオレンジ色に なるように ThisWorkbook.Sheets("Sheet2").Select Range("A1:A5").Select With Selection.Interior .ColorIndex = 46 .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With というのを入れてみたのですが，A，B，C以外のファイルを保存しなくても，マクロ が実行されてしまい，うまくいかないのですが。 よろしくお願いします。 （ミンミンゼミ） ---- ＞A，B，C以外のファイルを保存しなくても， ＞マクロが実行されてしまい，うまくいかないのですが。 と言う事ですが、 「A,B,C以外のファイルが保存されている時に実行する」 なんて記述がどこかにあるのですか？ ご提示の7行の中には有りませんが。 また、なさりたいことの確認ですが （テストとして）セル色をオレンジにするのは 　１．A,B,C以外のファイルが有った場合全てのファイルのSheet2の範囲に実行 　２．A,B,C以外のファイルが有った場合、それらのファイルのSheet2の範囲に実行 どちらでしょう？ (HANA) ---- コードとやりたいことが乖離していますね。。。 また、同じProcedureにしなくてはいけないのかも疑問です。 追加されたコードはまったく別のこと、別フローにしても問題ないことのようです。 「たとえば」ではなく、具体的に、簡潔に、必要なことを知らせてください。 (ROUGE) ---- どうもすみません。分かりやすく説明するのは難しいですね。 具体的に説明させていただきます。 同一フォルダ内に，Ａ，Ｂ，Ｃの３つのファイルがあります。 それで，いろいろ教えてもらって，Ａファイルに下記のようなコードを作りました。 Sub () Dim ws As Worksheet, flg As Boolean For Each ws In Sheets If ws.CodeName = "xyz" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True flg = True Exit For End If Next If Not flg Then Exit Sub Dim aa, bb, astrLinks Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Application.ScreenUpdating = False For Each aa In fso.GetFolder(ThisWorkbook.Path & "\").Files If aa.Name <> ThisWorkbook.Name _ And aa.Name <> "A.xls" And aa.Name <> "B.xls" And aa.Name <> "C.xls" Then Workbooks.Open Filename:=ThisWorkbook.Path & "\" & aa.Name, UpdateLinks:=0 astrLinks = Workbooks(aa.Name).LinkSources(Type:=xlLinkTypeExcelLinks) If Not IsEmpty(astrLinks) Then For Each bb In astrLinks Workbooks(aa.Name).BreakLink Name:=bb, Type:=xlLinkTypeExcelLinks Next End If Workbooks(aa.Name).Worksheets(1).Cells.Copy ThisWorkbook.Worksheets(1).Cells Workbooks(aa.Name).Close False Exit For End If Next Application.ScreenUpdating = True Set fso = Nothing End Sub これは，同一フォルダ内にＡ，Ｂ，Ｃ以外のファイル，たとえばＤファイルを保存 したら，ＤファイルをＡファイルにコピーするものです。 そして，一度マクロを実行すると，その後はマクロは実行できず，Ｄファイルを 削除して，かわりにＥファイルを保存しても，マクロは実行されず，Ｅファイルが Ａファイルにコピーされることはありません。 でも，このままでは，最初の段階で，Ｄファイルをフォルダ内に保存しなくても， マクロが実行されてしまいます。 それで，一番始めに戻って， フォルダ内に，Ａ，Ｂ，Ｃ以外のファイルが見つからなかったらマクロを実行 しない。 Ａ，Ｂ，Ｃ以外のファイルが見つかったら，マクロを実行する。 というコードをコードの先頭に付け加えて，Ａ，Ｂ，Ｃ以外のファイルが見つから なかったらマクロの実行をロックするようなことをしたいのですが。 どうでしょうか。お願いします。 （ミンミンゼミ） ---- このマクロは、大きく分けて二つの部分から出来ていますが ＞このままでは，最初の段階で，Ｄファイルをフォルダ内に保存しなくても， ＞マクロが実行されてしまいます。 これは、上側の部分（ws.Delete）が実行されてしまう と言う事ですか？ でしたら、順番を考える必要が有ると思いますよ。 ＞Ａ，Ｂ，Ｃ以外のファイルが見つかったら，マクロを実行する。 これは、下側の部分で制御していますよね。 ＞ws.Delete は、上側の部分で行われています。 まず最初に 　ws シートの有無を確認して　無い場合は　Exit Sub 　有る場合は、次に進みます。 次の処理は、 　Ａ，Ｂ，Ｃ以外のファイルに対して、コピーを実行 　＆　フラグを立てる 最後に 　フラグが立っていれば　wsシートを削除 フラグが立って居なければ、コピーを実行していない （Ａ，Ｂ，Ｃ以外のファイルが無かった）のでそのまま終了 と言った感じで組み替えなおして見るのはどうでしょう。 ん？でも　よく見るとこれって上で （通りすがり）さんが書いて居られる事と同じですね。 やってみて、上手く行かなかったのでしょうか？ それとも、その直ぐ後にROUGEさんのコードが有るので そちらを先に試してみられたのでしょうか？ (HANA) ---- 何度か読み返して、HANAさんが噛み砕いてくださって、ようやく朧気ながらやりたいことが見えてきました。 フローとしては、このようなものでしょうか？ 　 １．A.xlsが入っているフォルダを調査 ２．A.xls、B.xls、C.xls以外のファイルがあるかどうか調査 ３．２でファイルが見つかった場合、そのファイルにCodeNameがxyzのシートがあるかどうか調査 ４．あればそのファイルの一番左のシートをA.xlsファイルの一番左のシートにコピペして保存せずに閉じる。 ： ： ： あれ？xyzシートの削除は必要なのですか？ 　 やりたいことをフローにしてみると、整理できて良いかもしれませんね。 VBAコードから推測するのでは非効率です。 (ROUGE) ---- ROUGEさん、「３」は違うくて 【A.xls】ファイルにCodeNameがxyzのシートがあるかどうか調査 では無いでしょうか。 それにしても、上記コードだと実行する度に （D.xlsとE.xlsが有った場合）AブックのWorksheets(1)に 重ねてコピーされてしまいますよね。 （どちらか一方しか貼り付いていない結果） と言う事は 「最初に当たったブックのみをコピー」 なんですかね。 それとも 「基本的に４つのブックしか入らない」 って事なんですかね。 或いは 「これはサンプルコードだから。実際は下に続けてコピーします！！」 って事なんですかね。 コピーしたらこのセルには必ずデータが入る ってセルが有るのなら 「そのセルが空だったらコピー。データが有ったらコピーしない」 程度でも良いのかもしれないですね。 （一つだけ貼り付ける場合ですが・・・。） (HANA) ---- 分かりにくい説明におつきあいしていただき，ありがとうございます。 順番に説明しますと以下のとおりになります。 ※　同一フォルダ内に，A，B，C　のファイルがある。 ※　マクロはAファイル上に作る。 ※　Aファイル上に，CodeNameがxyzのシートを作る。 １　フォルダ内に，A，B，C以外の名前のファイルがあるか調査する。 ２　A，B，C以外の名前のファイルが見つからなかったらマクロを実行しない。 ※　ここでフォルダ内に任意の名前のファイル（たとえばＤファイル）を貼り付ける。 ３　フォルダ内を再度調査し，A，B，C以外の名前のファイル　（たとえばＤファイル） 　　が見つかったら，マクロを実行する。 マクロの内容は ４　Aファイル上のCodeNameがxyzのシートを削除する。 ５　Ｄファイルのシート１を全選択して，Aファイルのシート１にコピーして 　　貼り付ける。 です。 また，このマクロは１回しか実行できない。 つまり，もう一度マクロを実行しようとしても，１，２，３までは実行されるのです が，４でxyzシートを削除しようとしても，既にxyzシートは削除されているので, ４から先に進まない。 よって，何かの誤操作で，マクロ実行後，Ｄファイルを削除して，代わりにＥファイル を貼り付けたとします。 そして，また誤操作で，マクロを実行しても，Ｅファイルの内容がAファイルにコピー されることはなく，AファイルはＤファイルの内容がコピーされたままである。 というようなことがしたいのですが。 お分かりいただけたでしょうか。　　 （ミンミンゼミ） ---- 1) まず Aファイルがそのフォルダに在るかどうかを確認ることからでは？ ↑おっと、これはマクロを記述してあるファイルでしたね... 無視してください。 2) なぜ CodeName なのでしょう？ (seiya) ---- こちらをご覧になったからじゃないですかね？ [[20080725130903]]『マクロボタンを２回目に押すと効かなくする』（サンハイツ） ミンミンゼミさんのコードを見た時に非常に↑が思い出されましたが ここまで来ると、ほとんど同じなので当然でしたね。（笑） (HANA) ---- なるほど... 私自身も覚えておりませんでした... ということは、最初にAファイルに該当シートが在るかどうか参照して なければ、そこでおしまいにすればよいのでは？ シートの確認はCodeNameでもSheetNameでも確認して、在ればマクロの最後に 削除するだけですから、どちらでもよさそうな気がしますが？ (seiya) ---- ようやく全貌が見えましたねｗ (ROUGE) '---- Sub Robust_Cicada() Dim ff, wb As Workbook, ws As Worksheet, flg As Boolean flg = False For Each ws In ThisWorkbook.Sheets If ws.CodeName = "xyz" Then flg = True Exit For End If Next If Not flg Then Exit Sub With CreateObject("Scripting.FileSystemObject") For Each ff In .GetFolder(ThisWorkbook.Path).Files If InStr(1, ff.Name, ".xls") > 0 Then Select Case ff.Name Case "A.xls", "B.xls", "C.xls" Case Else On Error Resume Next Set wb = Workbooks(ff.Name) If wb Is Nothing Then Set wb = Workbooks.Open(ff.Path) End If Exit For On Error GoTo 0 End Select End If Next If Not wb Is Nothing Then For Each ws In ThisWorkbook.Sheets If ws.CodeName = "xyz" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True Exit For End If Next ThisWorkbook.Sheets("Sheet1").Cells.Value = _ wb.Sheets("Sheet1").Cells.Value End If End With End Sub ---- どうもありがとうございます。 それで，上のコードで試してみたのですが，私が説明したフローの５番目にあります 「Ｄファイルのシート１を全選択して，Aファイルのシート１にコピーして貼り付ける。」 というところがうまくできません。 Ｄファイルが開いてしまって，変な動きになってしまいます。 あとの部分はうまく動いたのですが。 たとえば， A，B，C以外の名前のファイルが見つからなかったらマクロを実行しない。 Ｄファイルが見つかって，マクロを実行すると，マクロは１回しか実行できない。 というところはうまくできました。 いかがでしょうか。よろしくお願いします。 （ミンミンゼミ） ---- 貼り付けもうまくいっていないのでしょうか？ Ｄファイルは確かに開きっぱなしになっているとは思いますが。。。 上記修正してみました。 (ROUGE) '---- Sub Robust_Cicada() Dim ff, wb As Workbook, ws As Worksheet, flg As Boolean flg = False For Each ws In ThisWorkbook.Sheets If ws.CodeName = "xyz" Then flg = True Exit For End If Next If Not flg Then Exit Sub With CreateObject("Scripting.FileSystemObject") For Each ff In .GetFolder(ThisWorkbook.Path).Files If InStr(1, ff.Name, ".xls") > 0 Then Select Case ff.Name Case "A.xls", "B.xls", "C.xls" Case Else On Error Resume Next Set wb = Workbooks(ff.Name) flg = (wb Is Nothing) If wb Is Nothing Then Set wb = Workbooks.Open(ff.Path) End If Exit For On Error GoTo 0 End Select End If Next If Not wb Is Nothing Then For Each ws In ThisWorkbook.Sheets If ws.CodeName = "xyz" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True Exit For End If Next ThisWorkbook.Sheets("Sheet1").Cells.Value = _ wb.Sheets("Sheet1").Cells.Value If flg Then wb.Close False End If End With End Sub ---- どうもありがとうございます。 Ｄファイルの貼り付け，うまくいきませんでした。 それで，前に勉強したことを使って，下記のようにしたら，貼り付けがうまくいきました。 また，Ｄファイルが見つからない場合はマクロが動かないし，Ｄファイルを貼り付け後もマクロが動きません。 しかし，また問題があります。 実はＤファイルにはリンクが付いているのですが，Ｄファイルにリンクがある場合，下記のコードを実行すると， 「このブックには更新できないリンクが１つ以上含まれています。」 と表示されてしまいます。 このメッセージが表示されないで，自動でリンクを解除して貼り付くようにしたいのですが，どうすればいいでしょうか。 一応，コードの終りの方に「BreakLink〜」というのがあって，リンクを解除していると思うのですが，うまくいかないのです。 （ミンミンゼミ） Sub Robust_Cicada() Dim ff, wb As Workbook, ws As Worksheet, flg As Boolean flg = False For Each ws In ThisWorkbook.Sheets If ws.CodeName = "xyz" Then flg = True Exit For End If Next If Not flg Then Exit Sub With CreateObject("Scripting.FileSystemObject") For Each ff In .GetFolder(ThisWorkbook.Path).Files If InStr(1, ff.Name, ".xls") > 0 Then Select Case ff.Name Case "A.xls", "B.xls", "C.xls" Case Else On Error Resume Next Set wb = Workbooks(ff.Name) flg = (wb Is Nothing) If wb Is Nothing Then Set wb = Workbooks.Open(ff.Path) End If Exit For On Error GoTo 0 End Select End If Next If Not wb Is Nothing Then For Each ws In ThisWorkbook.Sheets If ws.CodeName = "xyz" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True Exit For End If Next If Not flg Then Exit Sub Dim aa, bb, astrLinks Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Application.ScreenUpdating = False For Each aa In fso.GetFolder(ThisWorkbook.Path & "\").Files If aa.Name <> ThisWorkbook.Name _ And aa.Name <> "A.xls" And aa.Name <> "B.xls" And aa.Name <> "C.xls" Then Workbooks.Open Filename:=ThisWorkbook.Path & "\" & aa.Name, UpdateLinks:=0 astrLinks = Workbooks(aa.Name).LinkSources(Type:=xlLinkTypeExcelLinks) If Not IsEmpty(astrLinks) Then For Each bb In astrLinks Workbooks(aa.Name).BreakLink Name:=bb, Type:=xlLinkTypeExcelLinks Next End If Workbooks(aa.Name).Worksheets(1).Cells.Copy ThisWorkbook.Worksheets(1).Cells Workbooks(aa.Name).Close False Exit For End If Next Application.ScreenUpdating = True Set fso = Nothing End If End With End Sub ---- 「動けば良い」ってなら特に言うことはありませんが そうでないなら、現在のコードを 日本語におきかえてみてはどうでしょう。 Dファイルを２回探しているように思いますが。 リンク解除については、 「値貼り付け」をすれば良さそうに思います。 １．セルを選択してコピー ２．値貼り付け ３．Esc の手順を記録に取ると、参考になるコードが得られると思います。 (HANA) ---- どうもありがとうございます。 なるほど，そうすると，上のROUGEさんの修正コードで，コピー貼り付けの部分を Workbooks(ff.Name).Worksheets(1).Cells.Copy ThisWorkbook.Worksheets(1).Cells とすると，Ｄファイルを１回探すだけで，うまく動きました。 それで，あとはＤファイルをリンク解除したいのですが，お教えのとおりやってみて 下のようなものを作ったのですが，うまくいきませんでした。 Ｄファイルのリンクを解除した上で，コピー貼り付けするようにしたいのですが， いい方法がありますでしょうか。 ご教示願います。 　 （ミンミンゼミ） Sub Robust_Cicada() Dim ff, wb As Workbook, ws As Worksheet, flg As Boolean flg = False For Each ws In ThisWorkbook.Sheets If ws.CodeName = "xyz" Then flg = True Exit For End If Next If Not flg Then Exit Sub With CreateObject("Scripting.FileSystemObject") For Each ff In .GetFolder(ThisWorkbook.Path).Files If InStr(1, ff.Name, ".xls") > 0 Then Select Case ff.Name Case "A.xls", "B.xls", "C.xls" Case Else On Error Resume Next Set wb = Workbooks(ff.Name) flg = (wb Is Nothing) If wb Is Nothing Then Set wb = Workbooks.Open(ff.Path) End If Exit For On Error GoTo 0 End Select End If Next If Not wb Is Nothing Then For Each ws In ThisWorkbook.Sheets If ws.CodeName = "xyz" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True Exit For End If Next Workbooks(ff.Name).Worksheets(1).Cells.Select Selection.Copy Workbooks(ff.Name).Worksheets(1).Cells.Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Workbooks(ff.Name).Worksheets(1).Cells.Copy ThisWorkbook.Worksheets(1).Cells If flg Then wb.Close False End If End With End Sub ---- コードを動かせる環境を整えるのが大変なので 動かさなくても分かるように 何が起きたのか、起きたことを教えて下さい。 ＞下のようなものを作ったのですが，うまくいきませんでした。 どの様に上手く行かなかったのですか？ エラーが出て止まったのなら 　エラーメッセージと、どの行で止まったのか 最後まで動いたが結果が希望と違うなら 　どの様にしたい所が、どの様に成ったのか ちなみに、コードネームがxyzのシートを２回探しているように思いますが ２回目は必ず有るので（消せばよいだけなので） 即刻消してしまいましょう。 　　xyz.Delete それから、削除の処理は後処理なので 一番最後に持ってきておくのがよいと思います。 (HANA) ---- どうもお世話になります。 上記コードでマクロを実行すると 「このブックには更新できないリンクが１つ以上含まれています」 というメッセージが表示されます。 そして，その下に「継続」と「リンクの編集」というボタンが表示されるので， 「継続」を押すと，ＡファイルにＤファイルのデータがリンクが解除された状態で貼り付きます。 上記コードのうち Workbooks(ff.Name).Worksheets(1).Cells.Select Selection.Copy Workbooks(ff.Name).Worksheets(1).Cells.Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False の部分をなくしてマクロを実行すると，リンクが付いたままコピー貼り付けされる ので，このコードはリンクを解除するために合っていると思われます。 ただ，「このブックには〜」というメッセージが表示されないで，自動的にＤファイルのリンクを解除して コピー貼り付けされるようにしたいのですが，いかがでしょうか。 （ミンミンゼミ） ---- こんにちは。かみちゃん　です。 横から失礼します。 > 「このブックには〜」というメッセージが表示されないで リンク更新をしないで開きたいということでしょうか？ Set wb = Workbooks.Open(ff.Path) の部分を Set wb = Workbooks.Open(ff.Path, 0) とすると、リンク更新せずに開くことができます。 （メッセージは表示されません） 詳しくは、Open メソッドのヘルプ等で引数UpdateLinksをご確認ください。 (かみちゃん) 2009-03-23 22:04 ---- ありがとうございます。うまくできました。 なるほど。分かりました。 すみませんが、あともう１つお聞きしたいことがあります。 上のコードを実行したとき、Ｄファイルが一瞬出現して、Ｄファイルのシートを全選択する 画面が現れてから、Ａファイルのシート１にコピー貼り付けされます。 このＤファイルが一瞬現れる現象をなくすことはできますでしょうか。 Ｄファイルが表示されることなく、Ａファイルにコピー貼り付けされるようにしたいのですが。 いかがでしょうか。 （ミンミンゼミ） ---- こんにちは。かみちゃん です。 > Ｄファイルが一瞬現れる現象をなくすことはできますでしょうか 勘違いしているかもしれませんが、以下のような感じではいかがでしょうか？ Application.ScreenUpdating = False '〜　処　理　〜 Application.ScreenUpdating = True (かみちゃん) 2009-03-25 12:40 ---- うまくできました。 私がイメージしていたものができました。 みなさん、大変お世話になりました。 本当にありがとうございました。 （ミンミンゼミ）