こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

EXCEL 時刻起動で複数ブックを1つにまとめる

お世話になります。

私のデスクトップの[テスト]というフォルダに[東京支店集計.xls]というブックがあります。
[テスト]フォルダの中にさらに[個人別]というフォルダがあり、この中に下記の3つのファイルが置いてあります。

東京支店_田中.xls
東京支店_鈴木.xls
東京支店_山本.xls

[やりたいこと]
毎日15:00になったら自動で上記3つのファイルを[東京支店集計.xls]に全データコピー貼り付けして[東京支店集計.xls]にデータを集約したいのです。
[東京支店集計.xls]には毎回全データ上書きしたいのです。

このとき個別の"東京支店_田中.xls"ブックなどは担当者によってフィルターなどがかけられている可能性があるため、集約時にはフィルターを取り除いた形で全データを貼り付けしたいです。

[個人別]フォルダ配下のファイルを集約する時、3つにのファイル名を指定するやり方でもいいですが、ファイルの数が増える場合もありますため、できれば[個人別]フォルダ配下のファイル全てコピー貼り付けする、という動作だと助かります。

私が考えているのは[東京支店集計.xls]にVBAで上記のファイルを集約するコードを作成して、15:00に起動して動かす、という流れなのかと思っております。
初心者のためVBAコードと時刻自動のセットの方法をご教授いただけすと大変助かります。

★東京支店集計.xlsのファイルパス
C:\Users\ユーザー名\Desktop\テスト\東京支店集計.xls

★個人別ファイルのファイルパス
C:\Users\ユーザー名\Desktop\テスト\個人別\東京支店_田中.xls
C:\Users\ユーザー名\Desktop\テスト\個人別\東京支店_鈴木.xls
C:\Users\ユーザー名\Desktop\テスト\個人別\東京支店_山本.xls

お手数をおかけしますが、どなたかお知恵をお借りできますでしょうか。
よろしくお願い致します。

環境
Excel2013
Windows7

投稿日時 - 2015-02-04 09:59:56

QNo.8910779

すぐに回答ほしいです

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

>今度は、3つの個別ファイルのデータが2行ずつ(見出しと次データ)だけが
>3ファイル分はりついてしまう状況になってしまいました・・・
>現時点でのAM列のデータがブランクだからでしょうか?

ブランクだとそうなりますね。


>ちなみにかならずデータ存在するのは列はI列の[担当者名]です。

I列の最終行を取得してコピー元のセル範囲としましょう。
下記コードで差替えてください。

With Wb.Sheets(1)
  .Range(.Range("A2"), .Cells(.Cells(Rows.Count, "I").End(xlUp).Row, "AM")).Copy _
    Tb.Worksheets("東京支店").Cells( _
      Tb.Worksheets("東京支店").Cells(Rows.Count, "I").End(xlUp).Row + 1, "A" _
    )
End With

投稿日時 - 2015-02-05 14:46:25

お礼

eden3616 さん、出来ました!

100%私が希望していた通りの動きになりました!

私の分かりづらい説明にも関わらず何度も何度もご丁寧にご説明いただきまして本当にありがとうございました!大変お時間をとってしまい申し訳ございませんでした。

今回は本当に助かりました!!!

このたびは本当にありがとうございました!

投稿日時 - 2015-02-05 15:09:45

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.5

ごめんなさい。
A列のみコピーしてました。

下記コードで差替えてください。

With Wb.Sheets(1)
 .Range(.Range("A2"), .Cells(Rows.Count, "AM").End(xlUp)).Copy _
    Tb.Worksheets("東京支店").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

投稿日時 - 2015-02-05 13:05:39

補足

eden3616 さん、何度もすいません。

今度は、3つの個別ファイルのデータが2行ずつ(見出しと次データ)だけが3ファイル分はりついてしまう状況になってしまいました・・・
現時点でのAM列のデータがブランクだからでしょうか?
ちなみにかならずデータ存在するのは列はI列の[担当者名]です。

何度もスイマセン!!

投稿日時 - 2015-02-05 14:17:55

ANo.4

>1点だけ問題がありまして実際のデータは月によってマチマチですが、
>行がA2から始まって約3,000行ほどあって、列はA1からAM1(固定)あります。

>たまに途中のデータ行や列がブランクのデータが存在する場合があるのですが、
>この場合、range範囲がここで止まってコピーされてしまい、
>残りのデータが無視されてしまうようです。

>途中に空白行、列があってもデータが存在する範囲を全て
>コピー貼り付けできるようにできませんでしょうか?

データのある範囲が不明であったため、そのような処理にしておりました。

With Wb.Sheets(1)
  .Range(.Range("A2"), .Range("A1").End(xlDown).End(xlToRight)).Copy _
    Tb.Worksheets("東京支店").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

  | 最終行の取得方法を変更しますので上記の箇所を
  ↓ 以下のVBAコードと差し換えてください。

With Wb.Sheets(1)
  .Range(.Range("A2"), .Cells(Rows.Count, "A").End(xlUp)).Copy _
    Tb.Worksheets("東京支店").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

追記:
上記コードでは「A」列の最終行をデータの最終行としています。
どの列が最終行となるか分からない場合はA~AM列の最終行を全て取得して
行数が一番多い行を最終行として判定することになります。
その場合は再度補足願います。

投稿日時 - 2015-02-05 11:12:12

補足

eden3616 さん、何度もご対応いただきましてありがとうございます!

ご教授いただきましたロジックで実行しましたところ、A列だけ張り付いてしまい、B列以降が張り付かなくなってしまいました。。。。

何度も申し訳ございませんが、再度ご教授いただけますでしょうか??

投稿日時 - 2015-02-05 12:43:21

ANo.3

>個別のブックを集約する際に1つのシートに集約したかったのです。。
>現状では個別にシートが出来ます。
>つまり[東京支店集計.xls]の[東京支店]というシートに下記の3つの
>ブックのデータが順に張り付かせたかったのです。(順番はどうでもいいですが)
>個別のデータのA1の見出しは無視して全てB2から貼り付けていくようにしたいのです、、
>ここまでご教授いただきました後に大変恐縮ですが、上記仕様になるようなロジックを
>再度ご教授いただけますでしょうか?本当に申し訳ございません。。

「A1の見出し」「B2から貼付け」とありますが、コピー元データの様式が
どのようなものか分かりません。(A1、B2の2セルだけの様式ではないですよね?)

フィルタ機能を使用して、かつ見出しがあるとのことですので以下のように仮定します。
・見出しは1行目である(1行目のA列~n列)←補足ではB2となっていますが・・・
・データは複数行である(2行目~n行目までのA列~n列)

以下のVBAコードは添付画像のようなデータで集約出来るようにしています。
東京支店集計.xlsファイルのVBAコードと差し換えてください。合わせて以下も作成願います。
・東京支店シートはあらかじめ作成しておいてください
・項目行である1行目はあらかじめ作成しておいてください
また、各個人用のブックのデータは連続で入力されている(空白セルがない)必要があります。

様式に関する情報が不足しているため想定するには限界がありますので、
この辺で一度回答させて頂きます。
(具体的な様式を補足頂ければ、修正致しますので補足願います)

余談ですが…
この方法ですと、取得元のデータがどのブックか分からなくなりますがいいんですか?
コピー時に別の列に取得元のファイル名やシート名、特定セルの値等を控える等は出来ますが。


■VBAコード
Sub Auto_Open()
  '型宣言
  Dim MyPath As String
  Dim MyFile As String
  Dim Wb As Workbook
  Dim Tb As Workbook
  Dim myRange As AutoFilter
  'パスの設定
  MyPath = "C:\Users\ユーザー名\Desktop\テスト\個人用\"
  '準備
  MyFile = Dir(MyPath & "*.xls")
  Set Tb = ThisWorkbook
  'ファイル別に処理
  Do While MyFile <> ""
    'ファイルを開く
    Set Wb = Workbooks.Open(MyPath & MyFile)
    'フィルタの解除
    Set myRange = Wb.Worksheets(1).AutoFilter
    If Not myRange Is Nothing Then
      Wb.Worksheets(1).Range("A1").AutoFilter
      Set myRange = Nothing
    End If
    'セル範囲のコピー
    With Wb.Sheets(1)
      .Range(.Range("A2"), .Range("A1").End(xlDown).End(xlToRight)).Copy _
        Tb.Worksheets("東京支店").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End With
    'ファイルを閉じる
    Application.DisplayAlerts = False
    Wb.Close (False)
    Application.DisplayAlerts = True
    MyFile = Dir()
  Loop
  '上書き保存してエクセル終了
  Tb.Save
  Application.Quit
End Sub

投稿日時 - 2015-02-04 20:30:48

補足

eden3616さん、たびたびのご連絡誠にありがとうございます!

今回ご教授いただきましたコードでほぼ完成できそうです!
本当にありがとうございました!

1点だけ問題がありまして実際のデータは月によってマチマチですが、行がA2から始まって約3,000行ほどあって、列はA1からAM1(固定)あります。

たまに途中のデータ行や列がブランクのデータが存在する場合があるのですが、この場合、range範囲がここで止まってコピーされてしまい、残りのデータが無視されてしまうようです。

途中に空白行、列があってもデータが存在する範囲を全てコピー貼り付けできるようにできませんでしょうか?

投稿日時 - 2015-02-05 10:09:15

ANo.2

No1です。

東京支店集計.xlsに標準モジュールを作成し、以下のVBAコードを貼り付けて上書き保存してください。
No1のタスクスケジューラへの登録で該当ブックを指定時間に開くように設定してください。
(Excelのセキュリティ設定は「すべてのマクロを有効にする」にしてください)
           ↓
▼「すべてのマクロを有効にする」を使用したくない場合▼▼▼
Excelのセキュリティレベルは以下選択してください。
・「デジタル署名されたマクロを除き、すべてのマクロを無効にする」
そのあと、以下のサイトの各項目(2箇所)を参照して設定頂き、
http://office.microsoft.com/ja-jp/excel-help/HA001231781.aspx
・「独自のデジタル証明書を作成して、自己署名する」
・「マクロ プロジェクトにデジタル署名を追加する」>「Excel の場合」
一度「東京支店集計.xls」を開いて添付画像のようにデジタル署名に対し許可を行ってください。
次回起動時から自動的にAuto_Openイベントが実行されます。
▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲


コードの内容は以下のようにしています。
・ブックが開かれたら対象フォルダ以下の「*.xls」ファイルを順次開きながら
 1つ目のシートを集計ブックへシートコピーして閉じます。
・各ブックをコピーし終われば、上書き保存してエクセルを終了させます。


補足:
・シート名が重複する場合はエクセルが勝手に(1)、(2)など添え字を付けてくれると思います。
・フィルタは削除しています。すべて表示させているわけではありません。
・東京支店集計.xlsをマクロを実行しないで開くにはエクセル起動したのち、
 「開く」より東京支店集計.xlsを選択後、Shftキーを押しながら「開く」を押してください。


■VBAコード
Sub Auto_Open()
  '型宣言
  Dim MyPath As String
  Dim MyFile As String
  Dim Wb As Workbook
  Dim Tb As Workbook
  Dim myRange As AutoFilter
  'パスの設定
  MyPath = "C:\デスクトップのフォルダパス\テスト\個人用\"
  '準備
  MyFile = Dir(MyPath & "*.xls")
  Set Tb = ThisWorkbook
  'ファイル別に処理
  Do While MyFile <> ""
    'ファイルを開く
    Set Wb = Workbooks.Open(MyPath & MyFile)
    'シートのコピー
    Wb.Sheets(1).Copy After:=Tb.Worksheets(Tb.Worksheets.Count)
    'フィルタの解除
    Set myRange = Tb.Worksheets(Tb.Worksheets.Count).AutoFilter
    If Not myRange Is Nothing Then
      Tb.Worksheets(Tb.Worksheets.Count).Range("A1").AutoFilter
      Set myRange = Nothing
    End If
    'ファイルを閉じる
    Application.DisplayAlerts = False
    Wb.Close (False)
    Application.DisplayAlerts = True
    MyFile = Dir()
  Loop
  '上書き保存してエクセル終了
  Tb.Save
  Application.Quit
End Sub

投稿日時 - 2015-02-04 13:46:17

補足

eden3616さん、早速のご連絡誠にありがとうございました!
当方からのご連絡が遅くなりまして誠に申し訳ございません。

ご丁寧なご説明いただきまして誠にありがとうございました!

ご教授いただきました方法で集約できました!
すごいです!!

で、すいません、私の説明が抜けていたのですが、個別のブックを集約する際に1つのシートに集約したかったのです。。現状では個別にシートが出来ます。

つまり[東京支店集計.xls]の[東京支店]というシートに下記の3つのブックのデータが順に張り付かせたかったのです。(順番はどうでもいいですが)

東京支店_田中.xls
東京支店_鈴木.xls
東京支店_山本.xls

個別のデータのA1の見出しは無視して全てB2から貼り付けていくようにしたいのです、、ここまでご教授いただきました後に大変恐縮ですが、上記仕様になるようなロジックを再度ご教授いただけますでしょうか?本当に申し訳ございません。。

何卒よろしくお願い致します。

投稿日時 - 2015-02-04 19:17:52

ANo.1

内容に不透明な部分があります。
以下を補足頂ければ具体的な回答が得られるかもしれません。

・コピー貼付の内容はシートのコピーですか、特定範囲のセルコピーですか?
 (シートであればコピー対象のシートはどれなのか、全てなのか等も)
 (指定範囲であれば変動する可能性があるのか、毎回同じセルアドレスなのか等も)
・エクセルのセキュリティはオプションのセキュリティーセンターより
 「すべてのマクロを有効にする」を利用できますか?

上記をふまえて、とりあえずリンクのみでの回答ですが。
以下のコードを組み合わせれば可能です。

▼指定時間でブックを開く(Windowsのタスクスケジューラを使用)
http://okwave.jp/qa/q5819352.html

▼ブックが開かれたら自動実行するマクロ(Workbook_OpenまたはAuto_Openイベント)
ttp://www.happy2-island.com/excelsmile/smile03/capter00706.shtml

▼Excelセキュリティレベルの変更(自動実行マクロを動作させるため)
ttp://excel-2013.blogspot.jp/2013/11/excel2013.html

▼ディレクトリ以下のブックを順次開いて処理
ttp://www.vbalab.net/vbaqa/data/excel/log/tree_613.htm

▼内容の転記
・シートのコピー
ttp://officetanaka.net/excel/vba/sheet/sheet05.htm
・セルのコピー
ttp://officetanaka.net/excel/vba/cell/cell09.htm

▼Excelのブックを保存して終了
ttp://www.nurs.or.jp/~ppoy/access/excel/xlA022.html

投稿日時 - 2015-02-04 10:53:00

お礼

eden3616さん、早速のご連絡ありがとうございます!
そして当方からの連絡が遅くなりまして申し訳ございません!

私の投稿内容が抜けだらけで大変申し訳ございませんでした。。

分り易い細かなご説明を複数いただきまして誠にありがとうございます!

まだ勉強中なので、ご教授いただきました情報を今後の参考にさせていただきます。
このたびはありがとうございました!

投稿日時 - 2015-02-04 19:24:03

あなたにオススメの質問