フォルダ内のファイルデータをひとまとめにしたいです

質問

エクセル2003です。
Cドライブに、『売上』というフォルダがあります。
売上フォルダの中には、下記画像のようにエクセルファイルがあります。
『本店.xls』　『銀座店.xls』　『お台場店.xls』　のデータを、『集計.xls』へひとまとめにして表示させたいのです。

データの内容は毎日更新され追加されていきます。
フォルダ内のファイルも、日によって変わり、
6/1は『本店.xls』　『銀座店.xls』　『お台場店.xls』
6/6は『本店.xls』　『日本橋店.xls』
6/10は『銀座店.xls』　『お台場店.xls』　『日本橋店』といった感じで、変更されます。

毎日、『集計』ファイルを開くと、フォルダ内全てのファイルがひとまとめになるようにしたいのです。

VBAで作ってみましたが、うまくいきません。
教えて頂けますか？よろしくお願い致します。

回答No.4

MSZ006 · ベストアンサー

＃３です。遅くなりましたが補足を見ました。

エラーの原因がよく解らないのですが、各店のファイルと集計ファイル以外のファイルはフォルダ内には存在していませんよね。

あと、各店のファイルの見出し行の「日付」に相当するセルが、添付画像ですと空白に見えますが「日付」とでも入力しておいてください。見出し行に空白セルがあると正常に動きません。（ひょっとしたらこれが原因かも）

見出し行を修正して再度動かしてみてください。

エラーで止まった時に何かエラーメッセージが出ませんか？
開きっぱなしのファイルは各店のエクセルファイルのうちのどれかですか？

お礼

回答ありがとうございます。
フォルダ内には、別のファイルは存在していませんが、見出し行へ文字を入力する事でエラーが回避できました！
おかげさまで出来そうです。
助かりました。ありがとうございました！

回答No.3

MSZ006

＃２です。
ちょっと違いますが作ってみました。

前提条件として、
（１）各店のファイルのsheet1のA1セルに店舗名が入力されている
（２）各店の表はsheet1に作成されている
（３）全てのファイルは同一フォルダ内にある
ことが必要です。

ご質問の例では各店の表が縦に並んでいますが、横に並ぶように作ってあります。
「集計」ファイルのsheet3に集計されます。

マクロ「summary」を実行してください。

Option Explicit
Private filename() As String
Private cnt As Long

Sub summary()
Application.ScreenUpdating = False
GetFileName
CopySheet
Application.ScreenUpdating = True
End Sub

Private Sub GetFileName() 'ファイル名一覧取得
Dim str As String
Dim i As Long
Dim path As String
Dim thisbook As String

path = ThisWorkbook.path + "\"
thisbook = ThisWorkbook.Name

str = Dir(path & "*.xls")
cnt = 1
Do While str <> ""
If str <> thisbook Then
ReDim Preserve filename(cnt)
filename(cnt) = str
Else
cnt = cnt - 1
End If
cnt = cnt + 1
str = Dir()
Loop
ReDim Preserve filename(cnt)
filename(cnt) = ""

End Sub

Private Sub CopySheet() '各店のシートを集計のsheet3にコピー
Dim str As String
Dim i As Long
Dim pos As Long
Dim lastrow As Long
Dim lastcolumn As Long
Dim key As String

Dim s_ws As Worksheet
Dim m_ws As Worksheet
Dim m_wb As Workbook
Dim Obj As Object

i = 1
Set s_ws = Workbooks(ThisWorkbook.Name).Worksheets("Sheet3")
Application.DisplayAlerts = False

str = ThisWorkbook.path + "\" + filename(i) 'コピー元ファイル名フルパス

Do While str <> ThisWorkbook.path + "\"
Set m_wb = Workbooks.Open(str)
Set m_ws = m_wb.Worksheets("sheet1")
key = m_ws.Range("A1").Value
lastrow = m_ws.Range("A2").End(xlDown).Row
lastcolumn = m_ws.Range("A2").End(xlToRight).Column
m_ws.Range(m_ws.Cells(1, 1), m_ws.Cells(lastrow, lastcolumn)).Copy 'コピー

Set Obj = s_ws.Cells.Find(What:=key)
If Obj Is Nothing Then
'初めて出てくる店の場合
pos = s_ws.Range("A2").End(xlToRight).Column + 1
If pos = 257 Then pos = 1

Else
'既出の店の場合
pos = s_ws.Cells.Find(What:=key).Column

End If

s_ws.Range(s_ws.Cells(1, pos), s_ws.Cells(1, pos)).PasteSpecial Paste:=xlPasteColumnWidths 'ペースト（列幅）
s_ws.Range(s_ws.Cells(1, pos), s_ws.Cells(1, pos)).PasteSpecial 'ペースト
m_wb.Close

i = i + 1
str = ThisWorkbook.path + "\" + filename(i) 'コピー元ファイル名フルパス
Loop

s_ws.Range("A1").Select
Application.DisplayAlerts = True

End Sub

補足

MSZ006さま

VBA作って下さってありがとうございました！
前提条件の通りにして何度かトライしているのですが、どうしてもエラーになってしまいます…。
あと、最初？に読み込んだファイルが開かれた状態になります…。

回答No.2

MSZ006

ちょっと興味をもったので考えてみたいのですが、仕様の詳細がよく分からないので、補足をお願いします。

＞フォルダ内のファイルも、日によって変わり、
＞6/1は『本店.xls』　『銀座店.xls』　『お台場店.xls』
＞6/6は『本店.xls』　『日本橋店.xls』
＞6/10は『銀座店.xls』　『お台場店.xls』　『日本橋店』といった感じで、変更されます。

１）たとえば6/10ですと本店がありませんが、この日は本店の売り上げが無かった、ということでしょうか？
　だとして、本店.xlsの表には6/10の行がない、ということですよね？

２）集計.xlsは必ず毎日開いて、各店の表を累積的に蓄えていく、ということですね？
　たとえば6/10に開くと、本店.xlsがありませんが、集計.xlsには過去の本店の情報がたまっている、ということですね？

３）支店（お店）は限定されてはなくて流動的なのでしょうか？
　現れるのは本店、銀座店、日本橋店、お台場店、の4店舗のみなのか、何店があるのか不明なのか？

以上、補足説明をお願いします。

補足

MSZ006さま
ご覧下さってありがとうございます。
補足させて頂きます。

１）はい、売上のない日は行はありませんので、仰る通りです。

２）はい、その通りです。

３）支店は沢山ありまして、流動的です。

以上で補足できましたでしょうか？もし不明な点がございましたら、お知らせください。どうぞよろしくお願い致します。

回答No.1

kuma310min

集計.xlsの
C3に、　=VLOOKUP(B3,[本店.xlsx]Sheet1!$A$3:$D$7,2)
D3に、　=VLOOKUP(B3,[本店.xlsx]Sheet1!$A$3:$D$7,3)
E3に、　=VLOOKUP(B3,[本店.xlsx]Sheet1!$A$3:$D$7,4)
下方向へ必要なだけコピー。

とりあえず、「本店」部分のみの一例です。

検索　→　転記　であれば、VLOOKUP関数の使い方を学べば可能でしょう。

補足

kuma310minさま
ご回答ありがとうございます。

でも、vloookupでは難しいです。
と言いますのも、6/1・6/2・6/3・・・と毎日データが追加されますので、関数では上記[集計]ファイルのような表示にする為には、毎日[集計]ファイルを開き、操作しなければなりません。

バッチ処理として、集計ファイルを開くと、昨日までのデータが一括されてひとまとめに表示されるようにしたいのです。
ですので、VBAでないと出来ないかと思います。

皆さま、回答継続してお待ちしておりますので、よろしくお願い致します。