• ベストアンサー

WorkBooksをオープンさせずにシートにコピーしたい【EXCEL VBA】

よろしくお願いします。 今あるブックにあるシートを別のブックにコピーしたいのですが、今考えているのは ここから//////// 'ブックを開く Workbooks.Open コピー元のブックのパス 'シートをコピー Worksheets.Item(コピーするシート名).Copy _ after:=Workbooks(コピー先のブック名).Sheets(1) 'ブックを閉じる Application.DisplayAlerts = False Workbooks.Item(コピー元のブック名)Close True Application.DisplayAlerts = True ここまで//// なのですが、コピーものとのブックが複数ある時、画面がチラチラしてしまいます。ブックをオープンさせずにシートを他ブックにコピーさせる方法ってないでしょうか。 ご存知の方がいらっしゃいましたら、ご教授お願いします。

  • hakku
  • お礼率53% (30/56)

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

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

画面のチラツキを押さえたいだけなら、画面の更新をやめればいいだけじゃないでしょうか？ ブックを開く前に Application.ScreenUpdating = False ブック閉じてから Application.ScreenUpdating = True

その他の回答 (3)

  • spsabu
  • ベストアンサー率11% (2/17)
回答No.4

ブックを開かないでリンクで関連付ける事ができます。 下記のリンクは 「ファイルにアクセスできなくなった場合の原因と対策」 ですが対策３が参考になると思います。

参考URL：
http://support.microsoft.com/default.aspx?scid=http://www.microsoft.com/japan/support/kb/articles/JP411/6/36.asp
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

先日Application.ExecuteExcel4Macro の質問があり それを思い出して、旧い時代のステートメンを使うことになりますが Sub test01() For i = 1 To 10 Cells(i, 1) = Application.ExecuteExcel4Macro _ ("'C:\My Documents\[aaa14.xls]売上げ1'!R" & i & "C2") Next i End Sub をやって見ると上手く行きました。 やった内容は （１）ＣドライブのMy Documentsフォルダ内の aaa14.xlsと言うエクセルファイルをターゲットにして （２）「売上げ1」というシート名のシート（必ずしもＳｈｅｅｔｓ（１）ではない）の （３）Ｃ２－－－＞Ｂ列のデータ（値）を いま開いている新規ブックＢｏｏｋ１のシート（Ｓｈｅｅｔ１）の Ａ１：Ａ１０にもって来れました。 ブックaaa14.xlsは開かれていませんし、閉じたようでもありませんでした。

  • kimitsjin
  • ベストアンサー率36% (4/11)
回答No.1

EXCEL VBA で "excel.application"ってのも 妙な話ですが使えないわけではないので、 他に良い回答がなかったら使って下さい。 Dim xlapp As Variant Dim bk As Variant Set xlapp = CreateObject("excel.application") xlapp.Visible = False ' ★この命令で、見えない状態でブックを開くことができる★ Set bk = xlapp.Workbooks.Open(コピー元のブックのパス) 　　　　　： 　　　　　： この開いたブックにアクセスするには、全てのEXCEL命令の頭に xlapp. をつければよい。 例： xlapp.Workbooks.Open xlapp.cells("A1") 等 　　　　　： 　　　　　： xlapp.Quit Set xlapp = Nothing

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • Excel VBA 非表示の別ブックへシートコピー

    Excel2010のVBAで、別のExcelブックを非表示で開いて、 シートをコピーすると、 「実行時エラー'1004':WorksheetクラスのCopyメソッドが失敗しました。」 というエラーが出て、正しくシートをコピーすることができません。 (1)のように自分のブックへはシートをコピーすることはできるのですが、 (2)のように別のExcelブック上でシートをコピーする場合と (3)のように別のExcelブック上にシートをコピーする場合の いずれも同様のエラーになります。 どのように記述すれば(2)と(3)でもコピーすることができるのでしょうか。 ------------------------------------------------------------- Sub test() 　Dim newEx As Excel.Workbook 　Dim newFile As String 　newFile = ThisWorkbook.Path & "\New_Book.xlsx" 　Set newEx = Workbooks.Open(newFile, UpdateLinks:=0) 　Application.Windows("New_Book.xlsx").Visible = False 　'(1)New_BookのSheet3を自分のブックにコピーする (正常) 　newEx.Worksheets("Sheet3").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 　'(2)New_BookのSheet3をNew_Bookにコピーする (エラー) 　newEx.Worksheets("Sheet3").Copy after:=newEx.Sheets(newEx.Sheets.Count) 　'(3)自分のブックのSheet3をNew_Bookにコピーする (エラー) 　ThisWorkbook.Worksheets("Sheet3").Copy after:=newEx.Sheets(newEx.Sheets.Count) 　Application.Windows("New_Book.xlsx").Visible = True 　Application.DisplayAlerts = False 　newEx.Save 　newEx.Close 　Application.DisplayAlerts = True 　Set newEx = Nothing End Sub -------------------------------------------------------------

  • vbaについて勉強中です

    以下の構文を実行しました。 結果、Ｂファイルにはｓｈｅｅｔ（仮）が挿入されましたがＡファイルのｓｈｅｅｔ１がコピーされません。 どこがどのように間違っているのかわかりません。 どなたかご教授ください。 Sub コピー() Dim sc '貼り付け先ファイルのシート数 Dim scn '貼り付け先ファイルのシート名 Dim F_T '貼り付け先ファイル名 Dim F_0 'コヒー元ファイル名 Dim cc 'コピー元のシート数 Dim ccn 'コピー元のシート名 On Error GoTo ed 'エラーの場合の処理 F_T = Application _ .GetOpenFilename("エクセルファイル(C:\Users\***\Desktop\B\B.xlsx),C:\Users\***\Desktop\B\B.xlsx", _ , "貼り付け先ファイルを開く") If F_T = False Then GoTo ed Workbooks.Open F_T F_T = ActiveWorkbook.Name sc = Workbooks(F_T).Sheets.Count '作業用の仮シートの追加 ActiveWorkbook.Sheets.Add After:=Worksheets(sc) ActiveSheet.Name = "仮" F_0 = Application _ .GetOpenFilename("エクセルファイル(C:\Users\***\Desktop\A\A.xlsm),C:\Users\***\Desktop\A\A.xlsm", _ , "コピー元ファイルを開く") If F_0 = False Then GoTo ed Workbooks.Open F_0 F_0 = ActiveWorkbook.Name cc = Workbooks(F_0).Sheets.Count 'このブックのシート名のすべてを繰り返し For f = sc To 1 Step -1 scn = Workbooks(F_T).Sheets(f).Name 'コピー元のブックのシート名を繰り返し For T = 1 To cc ccn = Workbooks(F_0).Sheets(T).Name 'もし、シート名が同じなら If scn = ccn And Workbooks(F_T).Sheets.Count > 1 Then 'シートの削除 Application.DisplayAlerts = False Workbooks(F_T).Worksheets(ccn).Delete Application.DisplayAlerts = True Else End If Next T Next f 'コピー元のブックのシート名を繰り返し For T = cc To 1 Step -1 ccn = Workbooks(F_0).Sheets(T).Name 'シートのコピー Workbooks(F_0).Worksheets(ccn).Copy _ Before:=Workbooks(F_T).Worksheets(1) Next T '作業用の仮シートの削除 Application.DisplayAlerts = False Workbooks(F_T).Worksheets("仮").Delete Application.DisplayAlerts = True Workbooks(F_0).Close SaveChanges:=False Exit Sub ed: MsgBox "エラーが発生したため、処理を取り消しました" End Sub

  • Excel VBA 指定シートの取込

    こんにちは。 ExcelのVBAを使用して、異なるBookのシートを取込みたいのですが、 シートが無かった場合の処理方法がわかりません。 現在のコードは下記の様になっております。 With Workbooks.Open"BOOK1.xls" .Worksheets("Sh1").Cells.Copy ThisWorkbook.Sheets("Sheet1").Range("A1") .Worksheets("Sh2").Cells.Copy ThisWorkbook.Sheets("Sheet2").Range("A1") .Worksheets("Sh3").Cells.Copy ThisWorkbook.Sheets("Sheet3").Range("A1") .Close End With Book1に指定したシートが無い場合、何もしないようにしたいのですが、 どの様に書き換えれば宜しいでしょうか？ よろしくお願いします。

  • 保護されたブックのコピーについて

    現在、ボタンを押すと新規ブックが作成され、最初のブックのシートをコピーするというマクロを組みました。 しかし、元になるブックにはブックの保護とシートの保護を両方かけていて、途中でエラーになるはずなのですが、何故かそうならずに普通に新規ブックにコピーがされます。 上手くいったのですがエラーが出ると予想していたので気持ちが悪く、また個人だけで使うわけじゃないので原因を知っておきたいです。 どなたかよろしくお願いします。 Private Sub makeBookButton_Click() Dim myWorkBook As String Dim newWorkBook As String Dim mySheet As Worksheet Application.ScreenUpdating = False On Error GoTo ErrTrap Application.DisplayAlerts = False myWorkBook = ThisWorkbook.Name Workbooks.Add ActiveWorkbook.SaveAs Filename:=NEWBOOK newWorkBook = ActiveWorkbook.Name Workbooks(myWorkBook).Activate For Each mySheet In ThisWorkbook.Worksheets Workbooks(myWorkBook).Sheets(mySheet.Name).copy after:=Workbooks(newWorkBook).Sheets(Workbooks(newWorkBook).Sheets.Count) Next Workbooks(NEWBOOK).Sheets("Sheet1").Delete Workbooks(NEWBOOK).Sheets("Sheet2").Delete Workbooks(NEWBOOK).Sheets("Sheet3").Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Exit Sub ErrTrap: Call MsgBox("ブック作成時にエラーが発生しました。", vbCritical) End Sub

  • VBAで複数シートをまとめたい

    VBAを作るのは今回が初めてで行き詰ってしまいました。 フォルダ内の「.xlsx」４つのファイルのSheet1(４つともSheet1です) を統合.xLsmの1月シートのb2～値でコーピー貼り付けを行いたいのですが、 下記のものでやっていけば出来のかなと思ってますが、ご教授お願い致します。 Private Sub CommandButton1_Click() Dim sFile As String Dim sWB As Workbook, dWB As Workbook Dim dSheetCount As Long Dim i As Long Dim c As Long Dim ws As Worksheet Debug.Print (ws.Index) Const SOURCE_DIR As String = "C:\Users\KWEUSER\Desktop\data\" Application.ScreenUpdating = False '指定したフォルダ内にあるブックのファイル名を取得 For c = 1 To 4 sFile = Dir(SOURCE_DIR & "*.xlsx") 'フォルダ内にブックがなければ終了 If sFile = "" Then Exit Sub '集約用ブックを作成 Set dWB = Workbooks.Add '集約用ブック作成時のシート数を取得 dSheetCount = dWB.Worksheets.Count Do 'コピー元のブックを開く Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile) 'コピー元の　c (1,2,3,4,5)シートを集約用ブックにコピー sWB.Worksheets(c).Copy After:=dWB.Worksheets(dSheetCount) 'シート名をファイル名に ActiveSheet.Name = sFile 'コピー元ファイルを閉じる sWB.Close '次のブックのファイル名を取得 sFile = Dir() Loop While sFile <> "" '集約用ブック作成時にあったシートを削除 Application.DisplayAlerts = False For i = dSheetCount To 1 Step -1 dWB.Worksheets(i).Delete Next i Application.DisplayAlerts = True '集約用ブックを保存して閉じる dWB.SaveAs Filename:="C:\Users\KWEUSER\Desktop\data\" & c & ".xlsx" dWB.Close Next Application.ScreenUpdating = False End Sub

  • エクセル　マクロ　簡素化

    マクロ初心者です。 下記のデータのコピペする、マクロを使用しています。 下記にはAAAとBBBの2つのエクセルへのコピペのみしか記述していませんが、 その下に50ファイル分のファイル名、コピー元、コピー先だけが違うマクロが並んでいます。 メンテナンスや更新に手作業で行っているので、非常に時間がかかります。 例えば、別のシートにファイル名、コピー元、コピー先の一覧を作成し、 そのシートでファイル名、コピー元、コピー先を修正し、コピペができるようになるなど、 どうにかして簡素化したいのですが、どのように実現すればいいか、教えてくださると助かります。 ---------------------------------------------------------------------- Private Sub CommandButton1_Click() 　　Dim wb As Workbook Application.ScreenUpdating = False Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\AAA.xls", UpdateLinks:=0) ThisWorkbook.Sheets("BBB").Range("A1:B1").Copy wb.Sheets("CCC").Range("A1:B1").PasteSpecial (xlPasteValues) Application.CutCopyMode = False Application.DisplayAlerts = False wb.Close (True) Application.DisplayAlerts = True Application.ScreenUpdating = True Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\BBB.xls", UpdateLinks:=0) ThisWorkbook.Sheets("BBB").Range("A2:B2").Copy wb.Sheets("CCC").Range("A2:B2").PasteSpecial (xlPasteValues) Application.CutCopyMode = False Application.DisplayAlerts = False wb.Close (True) Application.DisplayAlerts = True Application.ScreenUpdating = True 'アイテム名、コピー元、コピー先、だけがちがう、同じようなマクロが50ファイル分ある。 End Sub

  • エクセルVBAが途中で止まります

    以前別のカテゴリで質問したのですが、そちらでは解決出来なかったので、こちらで改めて質問します。 下記のマクロで、一つのブックからSheet1だけをコピーして来て、少し処理をし、元のブックを閉じるというもので、ブックの数は多くて3000程、少ない時は300位です。 で、このマクロだと９００位までですと最後まで行くのですが、それを超えるとリストが９５位で止まってしまいます。 自宅で別データを作ってやってみるとうまくいきました。 コピー元のブックにはテキストデータのみで、２００文字から５００文字程度の大きさしかありません。 ファイル名も５０文字程度の物を全部２０文字程度まで短くしてもみましたが、ダメでした。 どうかお知恵をお貸しください。 Sub ★1★ブックの結合() Dim sFile As String Dim sWB As Workbook, dWB As Workbook, aWB As Workbook Dim dSheetCount As Long Dim i As Long Dim SOURCE_DIR As String 'エクセルデータに変換されたファイルのあるフォルダを選択します。 MsgBox "エクセルに変換されたデータのフォルダを選択" With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then SOURCE_DIR = .SelectedItems(1) & "\" End If End With Application.ScreenUpdating = False '指定したフォルダ内にあるブックのファイル名を取得 sFile = Dir(SOURCE_DIR & "*.xls") 'フォルダ内にブックが無ければ終了 If sFile = "" Then Exit Sub '集約用ブックを作成 Set dWB = Workbooks.Add '転記マクロの中のDMリストシートをコピーする Workbooks("転記用マクロ.xlsm").Worksheets("DMリスト").Copy Before:=dWB.Worksheets("Sheet1") Application.DisplayAlerts = False Worksheets(Array("Sheet1", "sheet2", "sheet3")).Select ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True '集約用ブック作成時のシート数を取得 dSheetCount = dWB.Worksheets.Count Do 'コピー元のブックを開く Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile) 'コピー元のsheet1を集約用ブックにコピー sWB.Worksheets("sheet1").Copy After:=dWB.Worksheets(dWB.Sheets.Count) シート転記 'コピー元ファイルを閉じる Application.DisplayAlerts = False sWB.Close Application.DisplayAlerts = True 'セルA2の名前を変更する 'シート名をセルA2の値に変更 'ActiveSheet.Name = Range("A2").Value '次のブックのファイル名を取得 sFile = Dir() Loop While sFile <> "" '集約用ブックを保存する 'dWB.SaveAs Filename:=DEST_FILE Application.ScreenUpdating = False End Sub

  • VBA Workbooks.open

    ブックを開くコマンド × Workbooks("filename.xls").open ○ Workbooks.open filename:="filename.xls" 何故下なのですか？ワークブックコレクションの中から特定のブックを指定し開くなら、上の構文にした方がワークシートコレクション等と構文表現を統一出来ます。 現にブックを閉じるコマンドは Workbooks("filename.xls").close です。何故ブックを開くコマンドだけ別表現なのですか？

  • ブックの保護（シート構成）　でシートのコピー

    エクセルで外部データを参照させるために， 別のブックを開きシートをコピーし元のブックに貼り付け別のブックは閉じるというマクロを作成しました。 Workbooks.Open Filename:=a Sheets("データ").Select Sheets("データ").Copy After:=Workbooks("ファイル.xls").Sheets("メニュー") Workbooks(a).Close SaveChanges:=False a（変数）というファイルを開く シートのデータを選択 データをコピーし　ファイル.xls のメニューシートの後に貼り付け a(変数)のエクセルファイルを保存せずに閉じる 動作としては正常に動きました。 しかし、この　ファイル.xls　には ID とパスワードで管理しています。 その管理したシートがあるんですが、それを表示させないために シートを非表示→ブックの保護→シート構成　を行いました。 マクロを動かすと、シート構成をしているので Sheets("データ").Copy After:=Workbooks("ファイル.xls").Sheets("メニュー")　 が動かないことに気が付きました。 何かいい方法があればご教授お願いします。

  • ExcelVBA シートコピー

    ExcelVBAで管理表1のシート１へ管理表２のシート２へコピーするVBAを書いてみました。 以下部分を修正したいです。 wbSaki.Worksheets("シート２").Range("A1:VA3000").Copy こちらの選択範囲を最終行と最終列という風にしたいのですが、うまくコピー貼り付けができないので理由がわかる方がいらっしゃれば教えていただけますでしょうか。 以下全体コード------------------ Sub 管理表１のシート１を管理表２のシート２へを貼り付け() '選択したファイルを取り込み、別のファイルに貼り付ける。 Dim RC As Integer Dim OpenFileName, fileName, Path, SetFile As String Dim wbMoto, wbSaki As Workbook Set wbMoto = ThisWorkbook 'マスターデータ取り込み元をセット Application.DisplayAlerts = False Application.ScreenUpdating = False 'BOOKを開かない RC = MsgBox("管理表1を開きますか？", vbYesNo + vbQuestion, "確認") If RC = vbYes Then 'サーバー指定　End Withまで With CreateObject("WScript.Shell") strCdir = CurDir .currentdirectory = "ファイル格納先" OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") 'ダイアログボックスを表示して、マスターデータファイルを指定します。 If OpenFileName <> "False" Then SetFile = OpenFileName Else MsgBox "キャンセルされました" Exit Sub 'マスターデータの取り込みをキャンセル End If End With Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 'ダイアログボックスで指定したマスターデータファイルを開きます。 'VBA起動BOOKのシートをクリア wbMoto.Worksheets("シート1").Cells.Clear Set wbSaki = Workbooks.Open(Path & SetFile) '--- オートフィルタをクリアする ---' If wbSaki.Worksheets("シート２").FilterMode Then wbSaki.Worksheets("シート２").ShowAllData 'ワークブック間のシートをコピーします。 wbSaki.Worksheets("シート２").Range("A1:VA3000").Copy wbMoto.Worksheets("シート１").Range("A1").PasteSpecial xlPasteValues Application.CutCopyMode = False 'コピー切り取りを解除 wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる Application.ScreenUpdating = True 'BOOKを開かずに作業 Else MsgBox "処理を中断します" End If ThisWorkbook.Worksheets("元のシート").Select 'シート名を指定 Application.DisplayAlerts = True End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する