VBAで分割したBOOKが元データより大きい？！

質問

Sheets("DATA")とSheets("店舗一覧").の2枚のシートのBOOKがあります。
Sheets("DATA")は1行目は空白、2行目がタイトル行で3行目からがデータです。
配置は、A列が日付け（シリアル値）、B列が店舗名（文字）、C列が店舗コード（010～050）、DからM列までは数値、行数は2000程度のデータが日付け順に入っています。
Sheets("店舗一覧")にはA列に店舗名が50行あるだけです。

このデータを、B列の店舗名ごとにそれぞれ別のBOOKに切り分けようと下記のようなマクロを書きました。
ところが出来上がったBOOKをみるとなんとそれぞれが2054KBもあるのです。
元データのマクロがあるBOOKのサイズは、全データが入っていても251KBしかないのに、店ごとに切りわけたBOOKが2054KBとは腑に落ちません。
いったい何がおきたのでしょう？エクセル2000、Windows2000です。

Sub 分割TEST()
Dim c As Range
Dim ws As Worksheet, wb As Workbook
Dim x As Long, t As Single
Sheets("DATA").Range("A2:M2").AutoFilter
For Each c In Sheets("店舗一覧").Range("A1:A50")
Sheets.Add
Set ws = ActiveSheet
With Sheets("DATA")
.Range("A2").AutoFilter Field:=2, Criteria1:=c.Value
.Cells.Copy ws.Cells(1, 1)
End With
With ws
.Name = c.Value
.Move
Set wb = ActiveWorkbook
With wb
.SaveAs Filename:=ThisWorkbook.Path & "\" & c.Value & ".xls"
.Close (True)
End With
End With
Sheets("DATA").AutoFilterMode = False
Next c
End Sub

回答No.1

merlionXX · ベストアンサー

わたしもエクセル2000です。
何度やってもそのような現象が再現できないので回答をあきらめていましたが、ひょっとしてと思い試したところ再現しました。

>　配置は、A列が日付け（シリアル値）、C列が店舗コード（010～050）

A列がシリアル値とお書きですが、きっと表示はセルの書式設定で日付けにしてますよね？
C列も、店舗コード（010～050）ということは、頭の0を消さないため、これもセルの書式設定で文字列にしてますよね？
だとすれば、これです！

こちらでのテストでは、最初は書式をまったく考慮しなかったので再現しませんでしたが、Ａ列とＣ列のそれぞれの列全部に書式を設定したところ、まさにその現象が発生しました。
どうやら列全部に書式を設定したシートにオートフィルタをかけてSheets("DATA")で抽出したデータを　Cells.Copy で全部コピーし貼り付けると、貼り付けられた側のUsedrangeの行数は、フィルタで隠れた部分以外の全部の可視セルになってしまうようです。
つまり貼り付けられたデータに書式設定があるとそこもデータ領域となるようですね。（作成された新たなファイルでCtrl＋EndでLastCellを検索してみるとわかります。）
その結果、抽出データを貼り付けて新たに作成されたBOOKは元データのBOOKに比べて極端に大きなサイズになってしまいます。
これは自宅の2003でやっても再現できました。

原因がわかれば対策は簡単。（￣ー￣）v
元データ作成時に列全体に書式設定するのをやめるか、抽出したデータを　Cells.Copy で全部コピーするのをやめればいいんです。

Sub TEST01()
　　Dim c As Range
　　Dim ws As Worksheet, wb As Workbook
　　Sheets("DATA").Range("A2:M2").AutoFilter
　　For Each c In Sheets("店舗一覧").Range("A1:A50")
　　　　Sheets.Add
　　　　Set ws = ActiveSheet
　　　　With Sheets("DATA")
　　　　　　.Range("A2").AutoFilter Field:=2, Criteria1:=c.Value
　　　　　　.UsedRange.Copy ws.Cells(1, 1)
　　　　End With
　　　　With ws
　　　　　　.Name = c.Value
　　　　　　.Move
　　　　　　Set wb = ActiveWorkbook
　　　　　　With wb
　　　　　　　　.SaveAs Filename:=ThisWorkbook.Path & "\" & c.Value & ".xls"
　　　　　　　　.Close (True)
　　　　　　End With
　　　　End With
　　　　Sheets("DATA").AutoFilterMode = False
　　Next c
End Sub

(´^∇^)σ　いかがでしょう？

お礼

たいへん詳しくご説明いただき、有難うございます。
まさにおっしゃる通り、データがどこまでになるか不定なので列全体に書式設定をしていました。
Cells.Copy で全部コピーするのをやめ.UsedRange.Copy と変えただけでサイズがいきなり100分の1になりました！

ありがとうございます。