• ベストアンサー
  • すぐに回答を!

Excel 2007 マクロ 別ブックのシートをコピーする方法

Excel 2007 マクロ 別ブックのシートをコピーする方法 別ブックのシートをコピーして アクティブなブックのシートにコピーしたいと思います。 下記マクロを作成しました。 貼り付ける際に、クリップボードに保存するかどうか 聞かれるメッセージが表示されてうまくいきません。 またもっとシンプルな書き方があればアドバイスお願いします。 Sub 取り込み() Dim wb As Workbook Set wb = Workbooks.Open("\") Sheets("Sheet1").Select Cells.Select Selection.Copy ThisWorkbook.Activate ThisWorkbook.Sheets("特定").Select ActiveSheet.Cells(1, 1).Select ActiveSheet.Paste wb.Close End Sub

共感・応援の気持ちを伝えよう!

  • 回答数3
  • 閲覧数3318
  • ありがとう数8

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.2

No1 merlionXXです。 さっきのでも大丈夫だとは思いますが、念のため修正しておきます。 Sub 取り込み03()   Dim wb As Workbook   Set wb = Workbooks.Open("\") '省略   wb.Sheets("Sheet1").Cells.Copy ThisWorkbook.Sheets("特定").Cells   wb.Close (False) End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答ありがとうございました。シンプルな内容でわかりやすいです。

関連するQ&A

  • 新しく開いたブックをアクティブにするマクロ

    マクロ 新しく作ったブックをアクティブにする マクロ初心者です。 マクロを使って同階層にあるファイルのアクティブのシートを ひとつのブックにコピーして保存するマクロを作りたいと思ってます。 他の質問を参照して下記のコードを途中まで作成しました。 参照した質問では、 マクロの入っているブックにシートをコピーするようでしたが、 そうすると保存した時にマクロも保存されてしまうので 私なりに調べて、新しいブックにシートコピーするようにしましたが、 この記述の後、新しいブックをアクティブにする記述がわからず、 保存できなくなってしまいました。 ここまで終わるとマクロの入っているブックがアクティブになって終わります。 このあと新しく開いたブックをアクティブにして、 ブックのsheet1~3を削除して、名前をつけて保存したいのですが 開いたブックをアクティブにするマクロをご伝授ください。 あたらしくブックをつくるとbook1~・・・と名前が変わってしまうので 変数で名づけたいのですが、やり方が良くわかりませんのでよろしくお願いします。 何卒よろしくお願いします。 Sub consolid_test() Dim shCnt As Integer Dim Wb As Workbook Dim i As Integer Dim sh As Worksheet Dim nSh As Worksheet Dim fName As String Dim ka As String Application.ScreenUpdating = False '画面更新を一時停止 Application.DisplayAlerts = False Set mb = Workbooks.Add '新しいコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fName = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fName = Empty '全て検索 If fName <> mb.Name Then 'ブック名がこのブックの名前でなければ Set Wb = Workbooks.Open(myfdr & "\" & fName) 'そのブックを開きwbとする。 Wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く ActiveSheet.Name = Range("B16") 'シート名の変更 ActiveSheet.Unprotect 'シート全体をコピーして値にする Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Wb.Close (False) '保存の有無を聞かずに保存しないで閉じる N = N + 1 'ブック数をカウント End If fName = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す ・ ・ ・ ・

  • エクセルVBAで作成した別ブックにVBAを記述したい

    VBAで別ファイルの作成は下記で出来ているのですが、出来上がったファイルにVBAを記述する方法がわかりません。 具体的には一番下のSub TEST()を新しいブックの標準モジュールに記述したいのと、sheet1に Private Sub Worksheet_Change(ByVal Target As Range) MsgBox "ChangeTEST" End Sub を入れたいです。 また Private Sub Workbook_Open() MsgBox "OpenTEST" End Sub も入れたいのです。 どうぞご教示ください。 Sub 複製() Dim wb As Workbook, sc As Integer sc = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Set wb = Workbooks.Add Application.SheetsInNewWorkbook = sc wb.Sheets("Sheet1").Select ThisWorkbook.Sheets("Sheet1").Cells.Copy wb.Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Buttons.Add(123, 195, 68.25, 15).Select Selection.OnAction = "TEST" Selection.Characters.Text = "TEST" ActiveWorkbook.Close ThisWorkbook.Activate Sheets("Sheet1").Select End Sub Sub TEST() MsgBox "TEST!!" End Sub よろしくお願いします。

  • 他ブックからのシートコピーのマクロ

    マクロ初心者です。 下記マクロを完成する事が出来たのですが、一部修正がうまくいかない為投稿させていただきました。 マクロ内容:エクセルファイルを指定し、選択したシートを現在のブックにコピーする その際、不要な名前管理を削除してからコピー 修正したい箇所:指定したブックからコピーした際、シート参照の数式が入っていると外部参照になってしまう。 やってみた事:(1)(i)の前にarrayを入れる→外部参照のまま (2)(i)を削除してみた→外部参照にならなくたったが際限なくシートをコピーし続けた Sub 名前管理削除() Dim myPath As String Dim wb_A As Workbook Dim i As Integer ' myPath = Application.GetOpenFilename(("Excelファイル,*.xls*,CSVファイル,*.csv"), , "ブックを選択して下さい。") If myPath = "False" Then Exit Sub Set wb_A = Workbooks.Open(myPath) Dim name As Object For Each name In Names If name.Visible = False Then name.Visible = True End If Next On Error Resume Next ' エラーを無視。(削除件数にカウントしてしまいます) For Each nm In ActiveWorkbook.Names If InStr(nm.Value, "#REF") > 0 Or _ InStr(nm.Value, "\") > 0 Then nm.Delete i = i + 1 Else End If Next nm ' 終了の表示 MsgBox "不要な名前定義を削除しました。" & vbCr & _ "削除定義件数=" & i & "件", vbInformation, cnsTitle For i = 1 To wb_A.Sheets.Count wb_A.Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Next wb_A.Close False End Sub 不勉強で申し訳ございませんが、何卒よろしくお願いいたします。

その他の回答 (2)

  • 回答No.3
  • Wendy02
  • ベストアンサー率57% (3570/6232)

>Set wb = Workbooks.Open("\") ブック名が抜けていますが、以下では、myBook1.xls としました。 Sub Test1() Dim acWb As Workbook Set acWb = ThisWorkbook '必要に応じて変える On Error Resume Next With Workbooks.Open("myBook1.xls")    .Worksheets("Sheet1").Cells.Copy acWb.Worksheets("特定").Cells(1, 1)   .Close False End With Set acWb = Nothing End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答ありがとうございました。参考にさせて頂きます。

  • 回答No.1

単にクリップボードうんぬんのアラートを出さないようにするなら Application.DisplayAlerts = False wb.Close Application.DisplayAlerts = True のようにすれば警告はでません。 > またもっとシンプルな書き方があればアドバイスお願いします。 Sub 取り込み2() Dim wb As Workbook Set wb = Workbooks.Open("\")'ここは省略しただけですね? Sheets("Sheet1").Cells.Copy ThisWorkbook.Sheets("特定").Cells wb.Close End Sub こうすれば、最初からクリップボードを経由しませんから何もでません。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答ありがとうございました。

関連するQ&A

  • 同一フォルダの複数ブックの値を取得マクロ

    エクセル2010のマクロで困っています。 同一フォルダ内・複数ブックの 「異動表」というシートの特定のセルを抽出し、一覧にするマクロを素人ながら作成しようとがんばっています。 下記、マクロを作成したのですが、 必ず、98件(98ブック)前後でマクロが止まってしまいます。 【Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。】←ここで止まります。 なぜなのでしょうか??ご教授願います。 Sub (1)() Dim mb As Workbook, wb As Workbook Dim myfdr As String, fname As String, n As Integer Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xlsx") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Sheets("異動表").Range("A1").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("a1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("b1").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("b1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("b4").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("c1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("m2").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("d1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("退職金計算書").Range("d21").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("e1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 Application.ScreenUpdating = True 'コピー先のセルの内容を置き換えますか?=YES Application.DisplayAlerts = False '警告表示を出さない Application.CutCopyMode = False 'クリップボードのコピーを消す wb.Close (False) '有無を言わずに保存せず閉じる For Each c In mb.Sheets(mb.Sheets.Count).UsedRange '取り込んだシートの使用範囲に If c.FormulaR1C1 Like "=*!*" Then '他シート参照があれば c.Value = c.Value '値に変更 End If Next n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 Dim ws As Worksheet '全てのシートの色をなしにする For Each ws In Worksheets ws.Tab.ColorIndex = xlColorIndexNone Next MsgBox UCase(Environ("UserName")) & "さん、" & n & "件のブックをコピーしましました。" _ + Chr(&HD) + Chr(&HA) + "他シートを参照する式だけは値にしておきましたよ。" _ + Chr(&HD) + Chr(&HA) + "" _ + Chr(&HD) + Chr(&HA) + "", , "( ̄ー ̄)v " End Sub

  • ブック内のシートを新規ブックにコピーしたい

    アクティブになっているブックの複数のシート(具体的には30シート)をデータ、書式のみをコピーし保存したいのですが、どうもうまくいきません。 アクティブブックのシートには、フォームコントロールのボタンや、関数、リスト形式で指定したデータ(入力規則を利用し別ブックのデータシートを元の値に指定)など、全てをコピーしてしまいます。 現在のコーディングは以下のようにしています。 For intRow2 = 1 To ThisWorkbook.Sheets.Count If intRow2 > 5 Then ’6シート目からコピー cpyshtname = Trim(ThisWorkbook.Sheets.Item(intRow2).Name) ThisWorkbook.Sheets(cpyshtname).Copy after:=opn_book.Sheets("Sheet1") Sheets(cpyshtname).Name = cpyshtname opn_book.Sheets(cpyshtname).Cells.Copy opn_book.Sheets(cpyshtname).Cells.PasteSpecial Paste:=xlPasteValues opn_book.Sheets(cpyshtname).Cells.PasteSpecial Paste:=xlPasteFormats End If Next さらに新規に作ったブックには変更ができないようにしたいと考えています。 いろいろ、試したり、調べたりしたのですが、どうしても、値と書式のみのコピーができません。 おまけに結合したセルも解除されたりしています。 どなたか、解決策をご存知の方、ご教授ください。宜しくお願いします。

  • シートを別のブックに複数自動コピー

    初質問です。よろしくお願いします。 マクロを使って、あるブックのシート(20から50枚程度)を、別の貼り付け先のブックに自動的にコピーしようとすると、10回をすぎたあたり(必ずしも一定せず)で 「実行時エラー'1004': WorksheetクラスのCopyメソッドが失敗しました。」 というエラーと共にマクロが止まり、デバッグしようとすると 「ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート")」 のところで止まっています。 マクロの記述内容は以下の通りです。 Sheets("貼り付け元シート").Activate ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート") Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("A1").Select Windows("貼り付け元ブック.xls").Activate ・・・以下貼り付け元シートを変えつつ複数回繰り返し これができる様になれば非常にラクになるので、ぜひご教授願います。

  • エクセル マクロでシートをデスクトップに保存する

    ファイルにある複数のシートの中から、Bシートだけを抜き出してデスクトップに保存するマクロがわかりません。 他のサイトで以下のVBAがあったので参考にしたのですが Cドライブのマイドキュメントに保存されます。 デスクトップに直接保存したいです。 Sub シートコピーR() ' 1.保存したいシートをシートコピーする。 Sheets("Sheet1").Copy ' 2.アクティブシートのセル全体に対して、コピー&値のみ貼り付けをする。 ActiveSheet.Cells.Copy ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues 'ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False ' 3.アクティブブックを保存する。 ActiveWorkbook.SaveAs FileName:="C:\ファイル名.xls" End Sub 教えてください。

  • Excel マクロで複数ブックのデータを一つのブックにまとめる方法

    マクロ初心者です。 1つのフォルダの中に複数のbook(sheetも複数)があります。 これを新しい1つのbookにまとめたいです。 回答に下記マクロがありました。 Sub consolid() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Worksheets.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く wb.Close '開いたブックを閉じる n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox n & "件のブックをコピーしましました。" End Sub これで使用した所マクロを実行する度に何度も同じシートが コピーされてしまいます。 できれば同じ名前のシートは上書きにしてマクロを何度も使用できるように【各BOOKは毎週更新されて私のフォルダに入ってきます】したいのですが そのような事は可能なのでしょうか? どなたか分かる方教えてください。お願い致します。

  • エクセル マクロ コピー→シート保護解除→貼付

    いつもお世話になっております。 マクロ勉強中の者です。 2つの別ブックのシート(互いに任意)を同時に開いている前提での作業です。 (1)あるブックのシート(任意)は,シート保護が施されています。このシートのシート保護の解除をします。 (2)(1)で示したブックとは別のブックのシート(任意)に,次のようなマクロを設定してあり,指定した範囲のコピーを行います。 Sub コピー() コピー Macro Range("E6:AI73").Select Selection.copy End Sub (3)次に,(1)で示したブックのシート(任意)に次のようなマクロを設定してあり,先ほどコピーした内容を貼り付けます。 Sub 貼り付け() Range("E6").Select ActiveSheet.Paste  ActiveSheet.Protect End Sub (4)(1)で示したシートには,(2)で行ったコピーの内容を貼り付け,シート保護された状態で作業が終わります。 この一連の作業の中で,(1)の作業を省けないかと考えています。つまり, 別ブックのシートを2枚開いている状態で, ◎あるブックのシートの内容をコピー(範囲指定あり) →◎別のブックのシートに,シート保護解除して(2)でコピーした内容を貼り付け,(セル指定あり)シート保護して終了 (3)で示したマクロに ActiveSheet.Unprotect を付け加えて実行してみたのですが,うまくいきません。エクセルの性格上,「貼り付け」の前にシート保護解除の動作が入ることで,コピーした内容が失われ?て貼り付けることができないのかな?と感じているのですが,どなたかご教授いただけると嬉しいです。 エクセルのバージョンは,2016になります。

  • エクセル ブック間コピー マクロ

    ブックA(ブック名は固定)のシートA(シート名は毎回違います)を ブックB(ブック名は固定)の一番左へコピーしたいのですがうまくいきません。 動作 :シートAでマクロを実行しブックBへシートのコピー(挿入)します。 まず第一段階のブックAのシートAをブックBへのコピーがうまくいきません。 シートAが固定シート名ならコードは Sheets("A").Select Sheets("A").Copy Before:=Workbooks("B.xls").Sheets(1) ですが・・・・ Sheets("A").SelectをWith ActiveSheet.Selectにすれば良いのですか? 申し訳ないのですが、後教授お願いします。

  • ワークシートをコピーしたい

    下記載のサンプルマクロは「ワークシートをコピーして、追加したワークブックにコピペする」マクロなんですが、これを「ワークシートをコピーして、追加したワークシートにコピペする」にできないでしょうか? 出来るのであれば、値と書式の他に関数もそのまま貼り付けたいので御教授お願いします。 ただマクロは削除してマクロ抜きのコピペが理想です。 宜しくお願い致します。 Sub サンプル() Dim sc As Integer sc = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 ThisWorkbook.Sheets("オリジナル").Cells.Copy 'コピー Workbooks.Add 'ブック追加 Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlValues '値貼り付け Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlFormats '書式貼り付け Sheets("Sheet1").Name = "コピー" Application.CutCopyMode = False Application.SheetsInNewWorkbook = sc ActiveWorkbook.Close ThisWorkbook.Activate End Sub

  • VBA シートを別ブックの先頭・一番左にコピー

    このシート(例Sheet1)を別ブックの先頭・一番左にコピーしたいのです。 下記のコードは一番右にコピーです。 宜しくお願いします。 Sub SheetCopy5() Dim bk As Workbook  Set bk = Workbooks("コピー先のブック.xlsx")  ActiveSheet.Copy _    After:=bk.Sheets(bk.Sheets.Count) End Sub

  • エクセルでマクロを組み始めたばかりの者です。下記の

    エクセルでマクロを組み始めたばかりの者です。下記のようなマクロを組んでみましたが、27行目もしくは41行目のActiveSheet.Pasteで「実行時エラー‘1004‘: 変更しようとしているセルまたはグラフは保護されているため読み取り専用となっています…」というエラーメッセージが出て止まってしまいます。 しようとしている内容は、転送ボタンを押し各シートの指定セルへ一括転送(コピー)をしたいのです。 その際、転送先はシート保護をしておきたいのです。 エラーはエクセル2010で確認しましたが、職場のPCを使用するため2007や2003等他のバージョンを利用する可能性もあります。また、仕事で使用するため早急に使わなければならず焦っています。 Option Explicit Private Sub CommandButton2_Click() Call Macro2 End Sub Sub Macro2() Workbook.Open Filename:=”K:&#165;共有&#165;○○○.xlsm” ActiveSheet.Unprotect ThisWorkbook.Activate Range(”D4:G20”).Select Selection.Copy Windows(”○○○.xlsm”).Activate Range(”E7”).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveWorkbook.Save ActiveWindow.Close Application.CutCopyMode = False Workbook.Open Filename:=”C:&#165;Users&#165;Desktop&#165;×××.xlsm” ActiveSheet.Unprotect ThisWorkbook.Activate Range(”D4:G20”).Select Selection.Copy Windows(”×××.xlsm”).Activate Sheet(”△△△”).Select Range(”AF18:AI34”).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveWorkbook.Save ActiveWindow.Close Application.CutCopyMode = False Workbook.Open Filename:=”K:&#165;共有&#165;□□□.xlsm” ActiveSheet.Unprotect ThisWorkbook.Activate Range(”D4:G20”).Select Selection.Copy Windows(”□□□.xlsm”).Activate Sheet(”▽▽▽”).Select Range(”AF18:AI34”).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveWorkbook.Save ActiveWindow.Close Application.CutCopyMode = False MsgBox " 『○○○』と" & vbCrLf & "『×××』と" & vbCrLf & "『□□□』の" & vbCrLf & "規格を変更しました。" End Sub どの様に修正すれば良いのでしょうか? マクロが原因でしょうか?または他の原因があるのでしょうか? マクロ初心者のため、修正方法など具体的な詳細をお教えいただけないでしょうか。 お手数をおかけして申し訳ございませんが、よろしくお願いします。