複数のブックを1つのブックにまとめる方法 Home

Close

Excel VBAあらかると

 メールに寄せられた内容から
>質問です.......
内容はこうである。

Q.支店があってその支店で作成したブック売上表を1つのブックにまとめることができないか?

A.1つずつブックを開いてシート毎にコピッペで対応する。

誰もが知るテクニック。非常に明快ですね。
でも、このようなときはやはりVBAに限ります。WebMambow的コードで試作してみます。


 シナリオ  (仕様書)
@ まとめるブック名は「ブック集約.xls」とする。

A シートをまとめる複数のブックは、1つのフォルダーに格納する。実行ブックも同様とする。
   セットアップフォルダー → C:¥売上実績

B 支店を識別するブック名は、名前ではなく予めコード(数字)付けする。
   A支店:001  B支店:002  C支店:003

C まとめるシートの数は1ブック10シートに限定する。

D 複写先のシート名は、ブック名+空白1つ+シート名とする。

以上の条件を基本にプログラムします。
尚、フォルダー単位のブックを選択する場合は、フォルダーを指定してのDIR関数が考えられますがここでは、Array関数(配列)を使ってコードします。


 実行画面
実行は、ブック名「ブック集約.xls」シート「main」の合体ボタンをクリックします。


 マクロコード
 標準モジュールへ記述
Sub Merge()

'変数宣言
Dim o_fil, f_nam As Variant
Dim s, i, st As Integer

'実行の確認
If MsgBox("ブック内シートの統合処理を実行します。", vbYesNo + vbQuestion, "Mambow") = vbNo Then
  MsgBox ("処理を中断します。")
  Exit Sub
End If

'ブックが保存されているドライブの指定  (Cドライブ)
ChDrive "C"
'ブックが存在するフォルダーを指定
ChDir "C:\売上実績\"

'統合するブック名を配列指定
o_fil = Array("001", "002", "003")

'画面更新の無効化
Application.ScreenUpdating = False

'シートのコピールーチン開始

'コピー先シートのシート複写位置初期値
st = 2

For Each f_nam In o_fil
'シート統合するブックのオープン
  Workbooks.Open (f_nam & ".xls")

'コピー元 最大10Sheets  (仕様条件)
  If Sheets.Count > 10 Then
    s = 10
  Else: s = Sheets.Count
  End If

'シートの複写
  Sheets.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

'複写元ブックのクローズ  SaveChanges:=False→保存をしないで閉じる
  Workbooks(f_nam & ".xls").Close SaveChanges:=False

'Sheetsの名前変更  (ブック名+シート名)
  For i = st To ThisWorkbook.Sheets.Count
    ThisWorkbook.Sheets(i).Name = f_nam & " " & ThisWorkbook.Sheets(i).Name
  Next i

  st = ThisWorkbook.Sheets.Count + 1

Next f_nam

Sheets("main").Select

'画面更新の有効化
Application.ScreenUpdating = True

End Sub
※ サンプルでは、支店を3拠点(ブック名A支店:001.xls、B支店:002.xls、C支店:003.xls)と想定しプログラムしています。


 お試し版ダウンロード 

○Download file: excv080.lhz

○圧縮ファイルの内容: フォルダー毎圧縮しています。 (フォルダ名:売上実績)
               統合ブック  001.xls  002.xls  003.xls  (3支店分)
               実行ブック  ブック集約.xls

○解凍後、フォルダー  C:¥売上実績  を作成しそれぞれのブックをコピーし実行環境を整えます。

○実行方法:  ブック集約.xlsを起動し合体ボタンをクリックします。


           


Close