【マクロ】元データを別ファイルへコピペ＆自動更新したい

毎日更新される元データとなるデータファイルがあります。
それを、私のほうで集計する為に集計用のファイルを作っており、DBとして毎日データをコピペで蓄積しています。
これを自動反映できるようにしたいのですが、いい方法はありますでしょうか？

・元データは「実績0123」というようなタイトルで、毎日日付の部分は変更されてデータがきます。
項目列はA列からR列まであります。
集計用DBですが、蓄積しているので、更新したいのは今でいうと1月のデータです。
また、全部の列でははなく場合によっては特定の列のデータのみデータ蓄積・更新したい場合は
どのようにしたらよいか？ご教授頂ければ幸いです。

質問者からの補足コメント

• 

  補足要求です。
  ＞元データは「実績0123」というようなタイトルで、毎日日付の部分は変更されてデータがきます。
  項目列はA列からR列まであります。
  >>とういうことですが、「実績0123」というようなタイトルとは、
  シート名が「実績0123」ですか。
  ブック名が「実績0123」ですか。
  →説明不足で申し訳ありません。
  ブック名とシート名どちらも同じタイトルです。
  
  
  ＞毎日日付の部分は変更されてデータがきます。
  ＞項目列はA列からR列まであります。
  >> 日付はどの列ですか？
  >>見出しはありますか？
  →日付はD列にあります。見出しは売上日付です。
  
  
  >>イメージがよくつかめません。
  >>元データの図を添付していただけませんでしょうか。
  →添付いたしました。
  　横に長い為、画像が小さくなってしまう為K列までとL列以降で
  　2段に分けて表示しております。

  
  No.2の回答に寄せられた補足コメントです。 補足日時：2017/01/27 09:33

• 

  ＞集計用のファイルを作っており、DBとして毎日データをコピペで蓄積しています。
  >>このシートの図も添付していただけますか。
  >>そもそも、元データと集計用シートのイメージが判らないので、マクロの書きようがないです。
  →元データも集計用も列数、見出しは同じです。※添付参照ください。
  いつも自分でコピペをして蓄積をしていっているので（私のミスなのですが）
  1月からのデータを12月のデータに上書きをしてしまったりしてデータ集計がおかしくなってしまうことがあるので、それを防ぎたいので
  1月分のデータだけを更新するようにしたいです。すみません、言いたいことがうまく説明できず。。。

    補足日時：2017/01/27 09:34

• 

  ＞また、全部の列でははなく場合によっては特定の列のデータのみデータ蓄積・更新したい場合は
  ＞どのようにしたらよいか？ご教授頂ければ幸いです。
  >>これも、具体的に例を挙げて、どうなさりたいのか説明していただけませんでしょうか。
  →添付しております通り、黄色の列は元データではありますが集計用には不要な列な為
  　G、S~V列以外を転記できたらなと思ってでした。。。
  　ただ、コピペする際に削除すればいい話だとおもいますので、こちらについては大丈夫です。

    補足日時：2017/01/27 09:34

• エラーが出て、デバッグを押すと黄色になっている部分がエラーというような表示がされます。

  
  No.11の回答に寄せられた補足コメントです。 補足日時：2017/01/30 17:04

• モジュール部分添付します。

  
    補足日時：2017/01/30 17:06

• 

  こんにちわ。お礼を書き込んでしまったのでこちらに失礼いたします。
  
  先日は何度もご教授いたただきましてありがとうございました。
  №17にてご教授頂いたモジュールに書き直して実行したところ10分前後に短縮されました。
  
  おそらく、おっしゃっていただきました通り私のPCスペック能力が低い為に時間がかかってしまうようです。ある程度は改善されましたので、これで日々更新させていただきます。
  また、何かありましたらこちらに投稿させていただきますのでその際は、またご教授頂けますと幸いです。本当に助かりました、ありがとうございました。

  No.17の回答に寄せられた補足コメントです。 補足日時：2017/02/03 17:07

No.7 回答者： tatsu99 回答日時： 2017/01/27 20:57

バックアップ先の行の確認を行うようにしました。

No5,No6は無視してください。
-------------------------------------------
Option Explicit
Public Sub バックアップ処理()
Dim sh1 As Worksheet 'データシート
Dim sh2 As Worksheet 'バックアップシート
Dim sh As Worksheet '管理シート
Dim dataFolder As String '元データフォルダ
Dim dataFile As String '元データファイル
Dim dataSheet As String '元データシート
Dim myBook As String 'バックアップブック名
Dim backSheet As String 'バックアップシート
Dim fullpath As String '元データシートのフルパス
Dim maxRow1 As Long 'データシート最大行
Dim row1 As Long 'データシート行
Dim row2 As Long 'バックアップシート行
Dim yyyy As Long '年
Dim mm As Long '月
Dim rg1 As String 'データシートレンジ
Dim rg2 As String 'バックアップシートレンジ
If MsgBox("バックアップを開始します", vbOKCancel) = vbCancel Then Exit Sub
myBook = ThisWorkbook.Name
Set sh = Worksheets("管理")
dataFolder = sh.Cells(2, "A").Value
dataFile = sh.Cells(2, "B").Value & ".xlsx"
dataSheet = sh.Cells(2, "C").Value
backSheet = sh.Cells(2, "D").Value
If ExistsWorkSheet(backSheet) = False Then
MsgBox (backSheet & "は存在しません")
Exit Sub
End If
If Dir(dataFolder, vbDirectory) = "" Then
MsgBox (dataFolder & "は存在しません。")
Exit Sub
End If
fullpath = dataFolder & "\" & dataFile
If Dir(fullpath) = "" Then
MsgBox (fullpath & "は存在しません。")
Exit Sub
End If
Workbooks.Open fullpath
Workbooks(dataFile).Activate
If ExistsWorkSheet(dataSheet) = False Then
MsgBox (dataFile & "中に" & dataSheet & "は存在しません")
Workbooks(dataFile).Close
Exit Sub
End If
Set sh1 = Worksheets(dataSheet) '元データシート
maxRow1 = sh1.Cells(Rows.count, 1).End(xlUp).row '元データシートの最大行取得
If maxRow1 < 2 Then
MsgBox (dataSheet & "にデータなし")
Workbooks(dataFile).Close
Exit Sub
End If
yyyy = year(sh1.Cells(2, "D").Value) 'データの年を取得
mm = month(sh1.Cells(2, "D").Value) 'データの月を取得
'バックアップシートの書き込み開始位置を検索する
Workbooks(myBook).Activate
Set sh2 = Worksheets(backSheet) 'バックアップシート
For row2 = 2 To Rows.count
If sh2.Cells(row2, "D") = "" Then Exit For
If year(sh2.Cells(row2, "D")) = yyyy And month(sh2.Cells(row2, "D")) = mm Then Exit For
Next
sh2.Activate
sh2.Range("D" & row2).Activate
If MsgBox(backSheet & "の" & row2 & "行以降へ書き込みます", vbOKCancel) = vbCancel Then
Workbooks(dataFile).Close
Exit Sub
End If
Application.ScreenUpdating = False
'データをバックアップシートへコピーする
For row1 = 2 To maxRow1
rg1 = "A" & row1 & ":F" & row1
rg2 = "A" & row2
Workbooks(dataFile).Worksheets(dataSheet).Range(rg1).Copy Workbooks(myBook).Worksheets(backSheet).Range(rg2)
rg1 = "H" & row1 & ":R" & row1
rg2 = "G" & row2
Workbooks(dataFile).Worksheets(dataSheet).Range(rg1).Copy Workbooks(myBook).Worksheets(backSheet).Range(rg2)
row2 = row2 + 1
Next
Workbooks(dataFile).Close
Application.ScreenUpdating = True
MsgBox ("バックアップ処理完了　処理件数=" & maxRow1 - 2 + 1)
End Sub

'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal sheetName As String) As Boolean
Dim ws As Worksheet
ExistsWorkSheet = False
For Each ws In Worksheets
If UCase(ws.Name) = UCase(sheetName) Then
ExistsWorkSheet = True
Exit Function
End If
Next ws
End Function
-------------------------------------------------------

この回答へのお礼

何度もご丁寧に質問&ご教授いただきありがとうございます。
そして、わたしの説明の仕方が不明瞭で申し訳ありませんでした。
週明け試してみたいと思います。

お礼日時：2017/01/27 21:27

No.6 回答者： tatsu99 回答日時： 2017/01/27 20:21

すみません。

Option Explicit
Dim maxrow As String・・・・削除希望
Dim msgflag As Boolean・・・・削除希望
Dim exec_count As Long・・・・削除希望
上記の2,3,4行は使用していません。あっても、問題なく動作しますが、
あとで見たときに悩むかもしれませんので、削除しておいてください。

No.5 回答者： tatsu99 回答日時： 2017/01/27 20:02

以下のマクロを標準モジュールへ登録してください。

---------------------------------------------------------
Option Explicit
Dim maxrow As String
Dim msgflag As Boolean
Dim exec_count As Long
Public Sub バックアップ処理()
Dim sh1 As Worksheet 'データシート
Dim sh2 As Worksheet 'バックアップシート
Dim sh As Worksheet '管理シート
Dim dataFolder As String '元データフォルダ
Dim dataFile As String '元データファイル
Dim dataSheet As String '元データシート
Dim myBook As String 'バックアップブック名
Dim backSheet As String 'バックアップシート
Dim fullpath As String '元データシートのフルパス
Dim maxRow1 As Long 'データシート最大行
Dim row1 As Long 'データシート行
Dim row2 As Long 'バックアップシート行
Dim yyyy As Long '年
Dim mm As Long '月
Dim rg1 As String 'データシートレンジ
Dim rg2 As String 'バックアップシートレンジ
If MsgBox("バックアップを開始します", vbOKCancel) = vbCancel Then Exit Sub
myBook = ThisWorkbook.Name
Set sh = Worksheets("管理")
dataFolder = sh.Cells(2, "A").Value
dataFile = sh.Cells(2, "B").Value & ".xlsx"
dataSheet = sh.Cells(2, "C").Value
backSheet = sh.Cells(2, "D").Value
If ExistsWorkSheet(backSheet) = False Then
MsgBox (backSheet & "は存在しません")
Exit Sub
End If
If Dir(dataFolder, vbDirectory) = "" Then
MsgBox (dataFolder & "は存在しません。")
Exit Sub
End If
fullpath = dataFolder & "\" & dataFile
If Dir(fullpath) = "" Then
MsgBox (fullpath & "は存在しません。")
Exit Sub
End If
Workbooks.Open fullpath
Workbooks(dataFile).Activate
If ExistsWorkSheet(dataSheet) = False Then
MsgBox (dataFile & "中に" & dataSheet & "は存在しません")
Workbooks(dataFile).Close
Exit Sub
End If
Set sh1 = Worksheets(dataSheet) '元データシート
maxRow1 = sh1.Cells(Rows.count, 1).End(xlUp).row '元データシートの最大行取得
If maxRow1 < 2 Then
MsgBox (dataSheet & "にデータなし")
Workbooks(dataFile).Close
Exit Sub
End If
yyyy = year(sh1.Cells(2, "D").Value) 'データの年を取得
mm = month(sh1.Cells(2, "D").Value) 'データの月を取得
'バックアップシートの書き込み開始位置を検索する
Workbooks(myBook).Activate
Set sh2 = Worksheets(backSheet) 'バックアップシート
For row2 = 2 To Rows.count
If sh2.Cells(row2, "D") = "" Then Exit For
If year(sh2.Cells(row2, "D")) = yyyy And month(sh2.Cells(row2, "D")) = mm Then Exit For
Next
Application.ScreenUpdating = False
'データをバックアップシートへコピーする
For row1 = 2 To maxRow1
rg1 = "A" & row1 & ":F" & row1
rg2 = "A" & row2
Workbooks(dataFile).Worksheets(dataSheet).Range(rg1).Copy Workbooks(myBook).Worksheets(backSheet).Range(rg2)
rg1 = "H" & row1 & ":R" & row1
rg2 = "G" & row2
Workbooks(dataFile).Worksheets(dataSheet).Range(rg1).Copy Workbooks(myBook).Worksheets(backSheet).Range(rg2)
row2 = row2 + 1
Next
Workbooks(dataFile).Close
Application.ScreenUpdating = True
MsgBox ("バックアップ処理完了　処理件数=" & maxRow1 - 2 + 1)
End Sub

'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal sheetName As String) As Boolean
Dim ws As Worksheet
ExistsWorkSheet = False
For Each ws In Worksheets
If UCase(ws.Name) = UCase(sheetName) Then
ExistsWorkSheet = True
Exit Function
End If
Next ws
End Function
------------------------------------------------------
元データのA~F列、H~R列のみをコピーします。
管理シートは添付の図のようになっています。

この回答へのお礼

ご教授いただきましてありがとうございました。
無事、できました!!
何度もお手数をおかけしました。

ちなみに、大変恐縮ではございますが
違うパターンの場合もお伺いできますでしょうか？

元データの列数が違うのですが、集計表へデータを貼り付けたいことは同じです。
※先にお伝えした通り、データは前日のデータ+当日データなので上書でOKです。
モジュールのどの部分を書き換えたら良いのでしょうか？

○元データファイル
ファイル名、シート名ともに「実績0123」です。
A列からR列まであります。
日付はL列(見出しは納入日付)です。
すべてのデータをコピペしたいです。

○集計先
A列からE列まで作業列がある為、F列からへデータを貼り付けたいです。

度々で申し訳ございませんが、ご教授願います。

お礼日時：2017/01/30 11:50

No.4 回答者： tatsu99 回答日時： 2017/01/27 16:56

念のため確認です。

>元データ「実績0123」には1月分のデータしかありません。
>集計用(元データコピペ先)にはそれ以前の12月、11月といった前のデータも蓄積されているので
>上書きされないように1月の日付のところから更新をしたいという意味でした。

そのようにすると（1月の日付のところから更新をする）、
例えば、本日に「実績0123」のデータをバックアップし、
翌日に「実績0124」（これも1月分のデータとします）のデータをバックアップすると
「実績0123」のデータは全てなくなりますが、それで良いのでしょうか。

それとも、「実績0124」が前日の「実績0123」のデータを全て含んでいると理解して良いのでしょうか。

つまり、
「実績0101」は1月分の当日のデータ
「実績0102」は、前日のデータ＋当日データ
・・・・
「実績0123」は、前日のまでのデータ＋当日データ
のように、実績データが作られてくるのでしょうか。

この回答へのお礼

本当に何度も申し訳ありません。

おっしゃる通り、実績0124は実績0123を含むデータになります。
ですので、上書きをしたいという結論になります。

お礼日時：2017/01/27 18:31

No.3 回答者： tatsu99 回答日時： 2017/01/27 11:40

補足ありがとうございました。

元データのA~F列、H~R列のみをコピーしたい旨、理解しました。

＞1月分のデータだけを更新するようにしたいです。
この意味が理解できません。
質問１）
「実績0123」には、1月以外のデータもあるのですか。1月以外のデータがなければ、2行目以降を全行コピーします。
もし、1月以外があるのなら1月分の全行をコピーします。

コピーする際は、バックアップ用のシートの最後の行の後に、付け加えていけばよいのですか。
そうすると、マクロを２回実行すると、同じものが２回コピーされてしまいますが宜しいでしょうか。

質問２）
コピー元のブック名が毎回変わるので、このブック名を指定できるようにします。
シート名：管理　に添付の図のように指定した後で、
マクロを実行するようにします。
添付の図の黄色の箇所が指定する箇所です。
A2:元データ（実績0123）のブックが格納されているフォルダ名です。
B2:元データのブック名です。拡張子は.xlsxとします。（実績0123.xlsx）
C2:元データのシート名です。ブック名と同じ値にしたい場合は、"=B2"と入力してください。
ブック名と異なるシート名も指定できるようにしています。
D2:対象元データのコピー対象となる年月です。
日付（2017/1/1等）を指定します。表示は年月にしておいてください。
日付の年、月を採用します。（黄色マーカー部分）
もし、元データの2行目以降が全てコピー対象なら、この列は不要になります。
その場合は、その旨、返信ください。
E2：バックアップシート
このシートの最後の行の後にコピーしたデータを付け加えていきます。
（このシートの1行目の見出しは自動で作成しません。見出しが必要な場合、シート作成時にあなたが見出しを作成してください。このシートが空の場合は１行目からデータを書き込みます）

上記の要領でよいでしょうか。

この回答へのお礼

お手数をおかけしております。
下記、回答しておりますのでご確認頂ければ幸いです。

＞1月分のデータだけを更新するようにしたいです。
この意味が理解できません。
>> 質問１）
「実績0123」には、1月以外のデータもあるのですか。1月以外のデータがなければ、2行目以降を全行コピーします。
もし、1月以外があるのなら1月分の全行をコピーします。
→説明が下手で申し訳ありません。
元データ「実績0123」には1月分のデータしかありません。
集計用(元データコピペ先)にはそれ以前の12月、11月といった前のデータも蓄積されているので
上書きされないように1月の日付のところから更新をしたいという意味でした。

>>コピーする際は、バックアップ用のシートの最後の行の後に、付け加えていけばよいのですか。
そうすると、マクロを２回実行すると、同じものが２回コピーされてしまいますが宜しいでしょうか。
→最後の行ではなく、上記でも述べましたとおり1月の日付のところからすべて上書きで更新したいです。

>>質問２）
D2:対象元データのコピー対象となる年月です。
日付（2017/1/1等）を指定します。表示は年月にしておいてください。
日付の年、月を採用します。（黄色マーカー部分）
もし、元データの2行目以降が全てコピー対象なら、この列は不要になります。
その場合は、その旨、返信ください。

→D2ですが、元データの2行目以降をすべてコピー対象にしたいです。
　それ以外については、tatsu99さんがおっしゃる通りで問題ございません。

何度もお手数をおかけいたしますが、何卒よろしくお願いいたします。

お礼日時：2017/01/27 13:20

No.2 回答者： tatsu99 回答日時： 2017/01/23 16:50

補足要求です。

＞元データは「実績0123」というようなタイトルで、毎日日付の部分は変更されてデータがきます。
項目列はA列からR列まであります。

とういうことですが、「実績0123」というようなタイトルとは、
シート名が「実績0123」ですか。
ブック名が「実績0123」ですか。

＞毎日日付の部分は変更されてデータがきます。
＞項目列はA列からR列まであります。
日付はどの列ですか？
見出しはありますか？

イメージがよくつかめません。
元データの図を添付していただけませんでしょうか。

＞集計用のファイルを作っており、DBとして毎日データをコピペで蓄積しています。
このシートの図も添付していただけますか。

マクロでならなんとかなるとは思いますが、
そもそも、元データと集計用シートのイメージが判らないので、マクロの書きようがないです。

＞また、全部の列でははなく場合によっては特定の列のデータのみデータ蓄積・更新したい場合は
＞どのようにしたらよいか？ご教授頂ければ幸いです。

これも、具体的に例を挙げて、どうなさりたいのか説明していただけませんでしょうか。

この回答へのお礼

昨年はいろいろとご教授頂き感謝しております。
また、ご返信が遅れました申し訳ありません。

下記、質問の回答補足へ記載いたします。
わかりづらく、言葉足らず等あればご指摘ください。
よろしくお願いいたします。

お礼日時：2017/01/27 09:32

No.1 回答者： fujillin 回答日時： 2017/01/23 14:52

こんにちは

＞これを自動反映できるようにしたいのですが、
＞いい方法はありますでしょうか？
元データの更新が何らかの自動処理で行われているのなら、同時にバックアップファイルにも同じ内容を蓄積する処理を追加してしまえばよさそう。
日付で識別できるのなら、シート名を日付にするとかでしょうか。

エクセルのシート数には直接の制限はないみたいですが、使用メモリとの見合いのようなので、データ量に応じて月単位とか数か月単位とかでファイルを分ける必要があるかもしれません。


自動での更新のされ方ではないのであれば、バックアップを作成するタイミングがわかりませんので、手動で起動してマクロで処理するのでも良さそう。
シート名（日付など）の管理と単純にシートをコピペする機能だけでもよさそうなので、それほど複雑にはならないと思います。


＞全部の列でははなく場合によっては特定の列のデータのみデータ蓄積・更新したい場合は どのようにしたらよいか？
どのようなケースにでも対応できるようにしてゆくと、全部手動でコピペするのとほとんど同じようなものになってしまうことが想像されます。
一定の傾向などがあって、まとめることで効率化ができそうであればマクロを利用するのも一法ですが、まずはどのようなものを用意すれば便利なのかを整理して考えてみることが第一歩ではないかと。