• ベストアンサー
  • 困ってます

同じフォルダ内のブックを開きコピーする方法

いろいろチャレンジしてみたのですが どうにも行き詰っております。 ご教示頂ければ幸いです。 1つのフォルダに3つ(数は固定)のシートがあります。 フォルダ名は毎回変わります。 C:\デスクトップ\作成 ├4328457 神戸 ├作成元データ(名前は固定)←Aとします。  ├1314 電源工事(名前は毎回変わります)←Bとします。 └見積.xls(名前は固定)←今回は使いません 毎回名前の変わるBを先に開き、下記の「FileOpen」マクロで Aを開きます。 Bにあるシート(数は変動)を全て、Aにあるシート(3枚固定)の前に コピーし、Bは閉じてしまい、Aにて作業をしたいと思います。 Sub FileOpen()   Dim Wb As Workbook   Dim Fname As String     Dim PathName As String    Set Wb = ActiveWorkbook   Fname = "作成元データ.xls" PathName = Wb.Path   If Right(PathName,1)="\" then   Workbooks.Open Filename:=PathName & Fname   Else     Workbooks.Open Filename:=PathName & "\" & Fname     ThisWorkbook.Active    End If End Sub 「ThisWorkbook.Active」にてBに戻しているつもりなのですが Aがアクティブのままであり、Bのシートをコピー選択できなくなってしまっています。 Sub BookOpen() Workbooks.Open Filename:=ThisWorkbook.Path & "\作成元データ.xls" End Sub こちらのように簡単な構図も試してみたのですが PESONAL.xlsbのあるフォルダ?を見に行くようでうまく「作成元データ」を開けませんでした。 お詳しい方には基本的な事かもしれませんが どうぞ宜しくお願い致します。   

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

  • 回答数2
  • 閲覧数241
  • ありがとう数1

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

  • ベストアンサー
  • 回答No.2
  • mt2008
  • ベストアンサー率52% (885/1701)

誤:ThisWorkbook.Active    ↓ 正:ThisWorkbook.Activate

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

質問者からのお礼

ごめんなさい・・ 補足に入力してしまったので 念のためこちらにも入力させていただきます。 mt2008さん 有難うございます。 会社でご指摘いただいたように 「ThisWorkbook.Activate」としても動かなかったのですが 家でやってみると正しく動きました。 大変助かりました。 本当に有難うございます。

関連するQ&A

  • Workbooks.openについて

    超初心者です。 Workbooks.Openを使って他の任意のxslファイルを開きたいのですが、 Sub Test_FileOpen() Workbooks.Open Filename = "c:\MyDocuments\data.xls" End Sub のように書いても 「実行時エラー'1004': 'False.xls'が見つかりません。ファイル名およびファイルの保存場所が正しいかどうか確認してください」 と言うアラートが出て上手くいきません。 ファイルのパスは何度も確認したので間違いはないです。 ちなみに同じフォルダに置いて、 Sub Test_FileOpen() Workbooks.Open Filename = ThisWorkbook.Path & "\data.xls" End Sub とやっても同じアラートが出ます。 どこがおかしいのでしょうか? 原因が推測できる方、どうかご教授願います。

  • 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

  • エクセルVBAでパスの¥マークについて

    このマクロを記述したBOOKと同じフォルダー内にある、シート001.xls を開くマクロです。 同一フォルダーにあるのですから、このような記述になると思います。 Sub kakunin1() Workbooks.Open (ThisWorkbook.Path & "\" & "シート001.xls") End Sub しかし、以下の3つはすべてシート001.xls を開くことができました。 Sub kakunin2() Workbooks.Open (ThisWorkbook.Path & "\" & "\" & "シート001.xls") End Sub Sub kakunin3() Workbooks.Open (ThisWorkbook.Path & "\" & "\" & "\" & "シート001.xls") End Sub Sub kakunin4() Workbooks.Open (ThisWorkbook.Path & "\" & "\" & "\" & "\" & "\" & "\" & "シート001.xls") End Sub パスの¥マークは階層をあらわすのだと思っていましたがいくつ重ねてもなぜ開くのでしょうか?非常に初歩的な質問だと思いますが、ご教示いただければ幸いです。

その他の回答 (1)

  • 回答No.1

Aを閉じていないからですね。(開いたままの状態) 多分。

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

関連するQ&A

  • ブックの集計方法について

    複数ファイルにある特定のシートのA列に記載がある時だけ、その行のA列からJ列までを、一つのファイルにコピーしたいと思っています。 ネットで調べてみたところ、エクセルで複数ファイルにある特定のシートの 特定した範囲を一つのファイルにコピーするマクロを探すことができました。 複数のシートから特定のシートのA列に文字がある場合は、J列までを一つのファイルの同じシートにコピーするようなことは出来ないでしょうか? (例えば、各ブックA列に10行ずつ文字がある場合は、このようなとりまとめをできないかと考えています。) ブック1(シート名:Q2)⇒集計シートのA1:J10 ブック2(シート名:Q2)⇒集計シートのA11:J20 ブック3(シート名:Q2)⇒集計シートのA21:J30 Sub ブック集合() Dim FileName As String Dim c As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean ChDir "c:/test" FileName = Dir("*.xls") Application.ScreenUpdating = False Application.DisplayAlerts = False c = 0 Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Workbooks(FileName).Sheets("Q2").Range("A1:J500 ").Copy _ ThisWorkbook.Sheets(3).Cells(c * 500 + 1, 1).PasteSpecial(xlPasteValues) c = c + 1 If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

  • 複数のブックの特定シートを1つのブックにまとめたい

    複数のブックの特定のシートを1つのブックにまとめたいのですが そのマクロは下記のように検索してでてきたのですが Sub test() Dim Fname As String Dim Wbm As Workbook Dim Wbs As Workbook Application.ScreenUpdating = False Set Wbs = ThisWorkbook Fname = Dir(ThisWorkbook.Path & "\*.xlsx*") Do While Fname <> "" If Fname <> ThisWorkbook.Name Then Workbooks.Open ThisWorkbook.Path & "\" & Fname Set Wbm = ActiveWorkbook Wbm.Worksheets("2016.03").Copy after:=Wbs.Worksheets(Wbs.Worksheets.Count) ActiveSheet.Name = Left(Fname, InStr(Fname, ".") - 1) Wbm.Close End If Fname = Dir() Loop Application.ScreenUpdating = True End Sub たとえば、特定のシートというのが毎回変わる場合今回は”2016.03"ですが 次回は”2016.04”という風に変わる時、どこかに入力したセルの値を元にシートを検索してくることなどは可能なのでしょうか? よろしくお願い致します。

  • ブックの終了がうまくいきません

    Excel2003 でマクロ作成中の超初心者です。マクロ完成まであと一歩になりました。次から進みません。お願いします。 ブックA ブックB ブックCの3個のブックがあります。 ブックAのコマンドボタン→ ブックBに飛びます。 ブックBには、フォームコントロール(終了するコマンドボタン)と、特定セルにコントロールが張り付けてあります。 ブックA→ブックBの終了ボタン →正常に終了します。 ところが、ブックBのコントロールから、ブックCに移り、 ここからも一度ブックBに戻って終了ボタンを押すとBブックは終了するものの、Cブックが閉じられません。なぜでしょうか? -----Bブックのセルに貼り付けたコントロールのマクロ----- Sub ブックCへ() Application.ScreenUpdating = False Dim wb As Workbook On Error Resume Next '開いて作業中の場合。 Set wb = Workbooks("21年計算01.xls") On Error GoTo 0 If wb Is Nothing Then Set wb = Workbooks.Open(ThisWorkbook.Path & "\21年計算01.xls") End If '開いて作業中の場合。 Workbooks("21年計算01.xls").Activate ActiveWindow.WindowState = xlMaximized - ---最大化 Worksheets(12).Select End Sub -----Bブックのフォームコントロールのマクロ----- Private Sub CommandButton5_Click() Unload Me ActiveWorkbook.Close SaveChanges:=True End Sub -----Cブックのフォームコントロールのマクロ----- Private Sub データ入力_Click() Unload Me Application.ScreenUpdating = False On Error GoTo err: Workbooks("21年計算02.xls").Activate Exit Sub err: Workbooks.Open Filename:=ThisWorkbook.Path & "\21年計算02.xls" '''データ処理.Show Application.ScreenUpdating = True End Sub

  • フォルダ内の全てのファイル開く時間短縮の方法

    Excelのマクロを使ってフォルダ内の全てのファイルを開く以下のコードを利用しているのですが(教えてgoo!で教えて頂いたコードです)、ファイル数が10個くらいあるため全部開くのに1分くらいかかってしまいます。 もっと時間を短縮することはできませんでしょうか? Sub OpenAllBook()   Dim FileName As String   Dim OpenedBook As Workbook   Dim IsBookOpen As Boolean   ChDir ("フォルダ名")   FileName = Dir("*.xls")   Do While FileName <> ""    If FileName <> ThisWorkbook.Name Then     IsBookOpen = False     For Each OpenedBook In Workbooks      If OpenedBook.Name = FileName Then       IsBookOpen = True       Exit For      End If     Next     If IsBookOpen = False Then      Workbooks.Open (FileName)     End If    End If    FileName = Dir()   Loop End Sub

  • ユーザーフォームを表示されないようにしたい

    Vista excel2007 でマクロ作成中の超初心者です。 A、B、Cのブックがあります。Bブックのみマクロをワークシートに貼り付けています。 1)Aブック(マクロ記録用)の中にある、Aコマンドボタンを押すと  BブックのBシートにジャンプします。ジャンプと同時に、Bユーザーフォームを 表示しています。 2)そしてBシートには、フォームコントロールを貼り付けており、ここをクリックするとCブックCシートに飛びます。 3)ところが、CシートにはBユーザーフォームが残ったままです。このフォームを  表示されないようにしたいのです。 4)Bシートのフォームコントロールには、次のコード記述をしてあります。       Sub Cブック Cシートへ() Dim wb As Workbook Dim ws As Worksheet Dim sh As Worksheet Dim i As Long ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path On Error Resume Next '開いて作業中の場合。 Set wb = Workbooks("CCC.xls") On Error GoTo 0 If wb Is Nothing Then Set wb = Workbooks.Open(ThisWorkbook.Path & "\CCC.xls") End If Worksheets(1).Select End Sub どうかよろしくお願いします。 

  • 複数ブックへ一括コピー

    150個ぐらいのエクセルファイルがあります。 スタイルはすべて同じで、特定のシートを別ファイルに用意したシート(エクセル表)で書き換えたいと思っています。 マクロの作成でテンプレファイルの読み込みから目的ファイルへの貼り付けをやってみて、WEBを参考にマクロを作ってみましたが、テストでエラー:オブジェクトが指定されていないとか出てしまい、さっぱりわかりません。 貼り付け元ファイル(テンプレ)は1つです。 貼り付け先ファイルは1つの元フォルダにフォルダでさらに分類されており、最大で3階層あります。 貼り付け元ファイルにあるシート(シート名:TITLE)を別のファイルの同じシートに貼り付けます。 シート名は1つだけです。 テンプレと目的ファイルのスタイルはまったく同じです。 どなたかよろしくお願いできないでしょうか。 以下に(失敗している)マクロを添付します。 ---------------- Sub Macro2() ' ' Macro2 Macro Workbooks.Open Filename:= _ "C:\Users\aaa\aaa.xls" Sheets("TITLE").Select Cells.Select Selection.Copy Dim fol As String Dim f As String Dim wb As Workbook fol = "D:\working" f = Dir(fol & "\*.xls") Do While f <> "" Set wb = Workbook.Open(fol & "\" & f) Sheets("TITLE").Select Cells.Select ActiveSheet.Paste ActiveWorkbook.Save wb.Close f = Dir() Loop Set wb = Nothing '変数の解放 End Sub

  • VBAでフォルダの中の1個のファイルを表示したい

    Windows10、Microsoft 365使用の超初心者です。 毎月1回、一個だけファイルを、フォルダ「計算表」に手動で入れています。 入れるのは、翌月のファイルで、A年B月計算表完成.xlsです。 いま、フォルダ「計算表」に、2年8月計算表完成.xlsが,1個 いれてあるので、エラーが発生します。 毎月1回のエラーを回避するため、何か良い方法を知りたいです。 よろしくお願いします。 Sub 最新計算書ひらく() Dim wb As Workbook Dim ws As Worksheet ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path On Error Resume Next Set wb = Workbooks("2年7月計算表完成.xls") If err.Number <> 0 Then Set wb = Workbooks.Open(ThisWorkbook.Path & "\計算表\2年7月計算表完成.xls") err.Clear End If Set ws = wb.Worksheets("集計") On Error GoTo 0 wb.Activate ws.Select・・・・・・ここでエラーになる End Sub

  • Excel VBAで異なるファイル間のコピー

    異なるファイル間で値のみをコピーしたいです。下記の様な感じです。 hoge1.xlsのA1からA10のセルの値のみをhoge2.xlsのB1からB10へコピーする。 以下の様に書いてみたのですが、数式がコピーされてしまいます。 VBAをやったことがなく、今ネットで30分ほど見て書いてみたので 根本的に理解していません。簡単な書き方を教えていただきたいです。 Sub test() Dim Fname As String Fname = "hoge1.xls" Workbooks.Open Filename:=Fname, ReadOnly:=True Dim range1 As Range Set range1 = Worksheets("Sheet1").Range("A1:A10") range1.Copy Destination:=Workbooks("hoge2.xls").Worksheets("Sheet1").Range("B1:B10") End Sub また、ファイルを開いたり閉じたりは必要なのでしょうか? Workbooks.Open Filename:=Fname, ReadOnly:=True を書かずに、いきなり Set range1 = Workbooks("hoge1.xls").Worksheets("Sheet1").Range("A1:A10") はダメなのでしょうか?? よろしくお願いします。

  • ブックの統合について

    Sub 集計() Application.ScreenUpdating = False fldPath = ThisWorkbook.Path & "\" fname = Dir(fldPath & "*.xls") Do Until fname = Empty If fname <> ThisWorkbook.Name Then Workbooks.Open fldPath & fname mx = Application.WorksheetFunction.Max(Sheets("1日").Columns(1)) lr = Sheets("1日").Range("B65536").End(xlUp).Row FR = ThisWorkbook.Sheets("1日").Range("B65536").End(xlUp).Row + 1 Sheets("1日").Rows("6:" & lr).Copy Application.DisplayAlerts = False ActiveWorkbook.Close (False) Application.DisplayAlerts = True ThisWorkbook.Sheets("1日").Cells(FR, 1).Select ActiveSheet.Paste Application.CutCopyMode = False End If fname = Dir Loop Application.ScreenUpdating = True End Sub 上記のようにマクロを組みましたが、集計したいシートがたくさんある為 シートごとにマクロを組みなおさなければなりません。 そこで、 集計するシートと集計されるシートのシート名が一緒の時、 わざわざsheets("1日")と書き直さなくても "Activesheetと同じシート名"のようなマクロの組み方は出来るのでしょうか。

  • マクロで複数ブックのデータを一つのブックにコピー

    マクロ超初心者です。 1つのフォルダの中に複数のbook(sheetも複数)があります。 これを新しい1つのbookにまとめたいです。 sheetは「bookを開いた時に表示されるsheetだけ」を新しい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 このマクロを使わせていただき、 これでいける!と思ったのですが、255文字以上のコピーが出来ません。 どのようにすればよいでしょうか?