エクセルでブック間のシートの合体？教えてください。

質問

エクセルの作業で困っちゃいました。
同じホルダー内に
0210A.xls、sから0309A.xlsの１２種類
0210B.xls、sから0309B.xlsの１２種類
0210C.xls、sから0309C.xlsの１２種類
0210D.xls、sから0309D.xlsの１２種類
の４８のブックがあります。（0210は2002年10月の意味です。）

各ブックは複数のシートを持っており、各ブックに共通してあるのは「AAA」、「BBB」、「CCC」の３種類で、それ以外のシートもあります。シートの順番は各ブックによりまちまちです。

これらのブックの共通する３種類のシートだけを合体して
0210AB.xlsから0309AB.xlsの１２種類、（AとBの合体）
0210CD.xlsから0309CD.xlsの１２種類、（CとDの合体）

の２４種類のブックを作りたいのです。
各ブックは「AAA」、「BBB」、「CCC」の３シートを持ちます。中身はオリジナルの各「AAA」、「BBB」、「CCC」の単純な寄せ集めです。
データは各シートとも１行目に項目、2行目以降にデータで、列はAF列まで使用しています。データの個数はまちまちで、オートフィルターを使用しています。
たとえば、0210A.xlsのシートAAAが200行であれば0210BのシートAAAのデータの一行目の項目は不要ですので2行目から最終行までコピーして201行以降に貼り付けるという感じです。同様にシートBBB、シートCCCも処理します。各シート１行目はオリジナルと同じ項目名とします。

手作業でやろうと思いましたが、誤りの発生もこわいのでVBAなどでうまくできる方法はないでしょうか？わたしのVBAの知識はマクロ自動記録ができるくらいなので助けてほしいのです。
Windows２０００でエクセルも２０００です。
よろしくお願いしま～す。

回答No.3

moon00 · ベストアンサー

各月のAとBのファイル、CとDのファイルを、まずは合成したい、ということでよろしいですか？
「～A」というファイルと「～B」というファイルの
シートAAAを集めるマクロを組んでみました。
作業に使うフォルダに「Book1」というファイルを作り、
ツール→マクロ→Visual Basic Editorを開いて
挿入→標準モジュールに貼り付けて下さい。
そしてツール→マクロ→test01を実行して下さい。

Option Explicit

Sub test01()
Dim fn As Variant
Dim Nfn As Variant
Dim NfnP As Variant
Dim Np As Variant
Dim lR As Integer
Dim msg01 As Variant
Dim Up As Integer
Dim Lft As Integer
Dim Btm As Integer
Dim Rgt As Integer
Dim St As Integer
Dim yesno As Variant

fn = InputBox("合成を行うファイル名を入力して下さい（末尾のアルファベットは除く）", "ファイル名の入力")
msg01 = "ファイル名 <" & fn & "A> <" & fn & "B>　の合成を行います。" '確認メッセージ

St = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
yesno = MsgBox(msg01, St, "確認")
If yesno = vbYes Then

Workbooks.Open FileName:="C:\WINNT\Profiles\user68\デスクトップ\" & fn & "A.xls"
Worksheets("AAA").UsedRange.Copy
ActiveSheet.Paste Destination:=Workbooks("book1.xls").Worksheets("Sheet1").Range("A1")
Np = ActiveWorkbook.Path 'パスを取得
Application.CutCopyMode = False
Application.DisplayAlerts = False '確認メッセージを出さない
ActiveWorkbook.Close '現在開いているブックを閉じる

Worksheets("Sheet1").Range("A1").Select
lR = Range("a65536").End(xlUp).Row + 1 'データの最終行の次の行を取得（次のコピー作業のため）

Workbooks.Open FileName:="C:\WINNT\Profiles\user68\デスクトップ\" & fn & "B.xls"
Worksheets("AAA").UsedRange.Copy
Application.DisplayAlerts = False '確認メッセージを出さない
ActiveWorkbook.Close '現在開いているブックを閉じる

ActiveSheet.Paste Destination:=Workbooks("book1.xls").Worksheets("Sheet1").Range(Cells(lR, 1), Cells(lR, 1))
Application.CutCopyMode = False

Worksheets("Sheet1").Rows(lR).Select '２回目コピーのタイトル行を削除
Selection.Delete Shift:=xlUp
Range("a1").Select
Worksheets("Sheet1").Name = "AAA"

Nfn = InputBox("新たなファイル名を入力して下さい", "ファイル名の入力", fn & "AB") 'ファイル名の確認
Np = ActiveWorkbook.Path 'パスを取得
NfnP = Np & "\" & Nfn & ".xls" 'パスと拡張子を付ける
ActiveWorkbook.SaveAs FileName:=NfnP '別名を付けてブックを保存する

End If

End Sub

これを元にしてシートBBB、CCCの作業、また「～C」「～D」の操作もできますが、
その応用ができないと、多分使いこなすのは難しいかと。
Excel97で動作確認してますので、もし動かなかったらすいません。

お礼

試行錯誤の結果なんとかできました！
ありがとうございました。

ただ一つだけ
ActiveSheet.Paste Destination:=Workbooks("book1.xls").Worksheets("Sheet1").Range("A1")

のペーストを

PasteSpecial Paste:=xlFormulas

を使いたいのですが、どう組み合わせたらいいのかわかりませんでした。

これは別の質問で書き込んでみます。
ありがとうございました。

補足

ありがとうございます。
上記でうまくシートの合成はうまくいきます。
（Workbooks.Open FileName:="C:\WINNT\Profiles\user68\デスクトップ\" のところは変えましたが）

ただ、合成された新しいブックにマクロがそのまま残ってしまうのです。
ActiveWorkbook.SaveAs FileName:=NfnP '別名を付けてブックを保存する
とやっているから当然なのですが。

そこでこの合成されたAAAシートだけを名前をつけて保存しようと、マクロの自動記録で「シートの移動またはコピー」で名前を付けて保存してみたのですがうまくマクロが記録されません。

このシート（マクロを含まない）だけを別名で保存するにはどうすればいいのでしょうか？
何度もすみません。

回答No.2

imogasi

AAAは各ブックに存在するシート名ですよね。
AAAを中心に説明すれば、４８種のファイル（＝ブック）を
読まないとダメと言うことですね。同一フォルダ内に４８ファイルあるらしいので、少し救われますが）
（１）４８個のブック名は、配列（FN）に入れてください。そしてFN(i）(iは1から48まで変化させる)のファイル名のブックを順次開く。そして（２）の処理を終わると
ブックを閉じる。そしてFN(i+1)を処理する。FOR　NEXT
で繰り回すと言うことです。
（２）１つのブックを開いたら、下記コーディング例を参考に全シートを舐め、シート名AAAを探し（IF)見つかれば
最下行を探し、第２行から最下行を複写して集めるあるブックのシートの今までに集めた次の行の下へ貼りつけてください。初回は第１行目から最下行までですね。
（行の並び順などは集約したシートが出来てからどうにでも手操作でなるでしょうから、考えずに行を集めるに徹する。）
Sub test01()
Dim sh As Worksheet
For Each sh In Worksheets
MsgBox sh.Name
MsgBox sh.Cells(1, 1)
Next
End Sub
＞マクロ自動記録ができるくらいなので
上記でヒントが掴めないようなら、VBAでやるのは難しいかもしれない。1回限りなら、総所要時間は、手作業とそう変わりませんよ。ただし手作業でやる場合は、作業の漏れとかダブリがないように、４８のブック名とAAA,BBB,CCCの表を作り、確実に済み印を押して一歩一歩やる必要があります。
VBAのコードを試行錯誤して組んだり、テストしたりすれば
VBAも完成までにすぐ数日経ちますよ。

補足

ありがとうございます。
>AAAを中心に説明すれば、４８種のファイル（＝ブック）を
読まないとダメと言うことですね。

いいえ、0210A.xls 0210B.xls(および0210C.xls 0210D.xls)のふたつのブックのAAA、BBB、CCCの３種類のシートをそれぞれまとめて0210AB.xls(および0210CD.xls)というブックをつくれればいいのです。
次に0211A.xls 0211B.xls(および0211C.xls 0211D.xls)のふたつのブックのAAA、BBB、CCCの３種類のシートをそれぞれまとめて0211AB.xls(および0211CD.xls)というブックをつくれればいいのです。

一回限りの作業なら手作業でするのですが、これからずっと続く作業になりそうなので困っているんです。
すみません、初心者には無理なのでしょうか？

回答No.1

popesyu

んー・・・そのブックの整理というのは一体何の為にやる作業なんでしょうか？
エクセルでは異ブック間の参照も異シート間と同じ様に出来ますので、別に一つに無理やりまとめなくても支障はないかと思うのですが。

もし、データの書式が変更されたとかでそれにあわせて修正したいということであれば、結構複雑そうな感じですのでこれを機にアクセスで管理するようにするとか。
あるいはエクセル上でやるなら管理用のブックというのを一つ作り、そこから各ブックへの入力や参照を行うようにするとかですね。そちらの方がすっきりするかと思います。

補足

早速ありがとうございます。
何のためかというと、これは４人（A～D）が毎月やっている電話受付、回答、処理などの記録をまとめるためなんです。
先月分であればA～Dの４人が0311A.xls～0311D.xlsという４つのブックに各人がそれぞれ１レコードを１行に記入しているデータをABチームとCDチームにまとめたいのです。
質問には書きませんでしたが、最終的には0311ABCD.xlsといった感じで全員をまとめたものも必要になりますが、とりあえずはチーム別の合体方法を知りたいのです。
よろしくお願いします。