| |
C:\Practiceにあるすべてのエクセルブックのうち、2010から始まるシートだけを集約（新規ブックに順次コピー）して、コピー後のシートには元ブックの名前をつけようとプログラミングしました。
しかし、C:\Practiceにあるエクセルブックには、2010から始まるシートが複数枚存在するブックも存在することに気づきました。
そのため、「AAA.xls」のシートが「2010_a」、「2010_b」、「2009_c」、「2010_d」と３枚の2010から始まるシートがあったとき、
新規ブックには「2010_a」、「2010_b」、「2010_d」がくっつくのですが、「2010_a」をAAA.xlsというシート名、「2010_b」を
AAA.xls_2というシート名、「2010_b」をAAA.xls_3というシート名がふられるように決めました。
しかし、この添え字が順次ふられる部分をどう書いていいものか分からず困っています。
申し訳ありませんが、ご教授願えないでしょうか？
よろしくお願いいたします。
Option Explicit
Sub 集約()
Dim PATH As String, MERGE_BOOKNAME As String
Dim PATH_BOOK_NAME As String
Dim INIT_SHEETS As Long, i As Long
Dim MERGE_BOOK As Workbook
Dim Sheet_No As Integer
'パスとファイル名
PATH = "C:\Practice"
MERGE_BOOKNAME = "集約.xls"
Set MERGE_BOOK = Workbooks.Add
'最初から付いてくるシートを消すための前処理
INIT_SHEETS = Worksheets.Count
'全ブック名の取得
PATH_BOOK_NAME = Dir(PATH & "*.xls")
Do While PATH_BOOK_NAME <> ""
'すべてのブックの先頭シートを新規ブックにコピー
If PATH_BOOK_NAME <> MERGE_BOOKNAME Then
With Workbooks.Open(PATH & PATH_BOOK_NAME)
'立ち上げたブックの先頭シートを新規シートの末尾にコピー
For Sheet_No = 1 To .Worksheets.Count
'2010から始まる名前のシートをコピーする
If Mid(.Worksheets(Sheet_No).Name, 1, 4) = "2010" Then
.Worksheets(Sheet_No).Copy after:=MERGE_BOOK.Worksheets(MERGE_BOOK.Worksheets.Count)
End If
Next
'追加したシートの名前を元のブック名とする
MERGE_BOOK.Worksheets(MERGE_BOOK.Worksheets.Count).Name = .Name
'立ち上げたブック（既存のフォルダ内）を保存せず閉じる
.Close savechanges:=False
End With
End If
PATH_BOOK_NAME = Dir()
Loop
'新規ブックに最初から付いていたシートをすべて消す 【★】と対応
For i = 1 To INIT_SHEETS
MERGE_BOOK.Worksheets(1).Delete
Next
'新規ブックを保存する
MERGE_BOOK.SaveAs PATH & MERGE_BOOKNAME
'変数MERGE_BOOKのクリア
Set MERGE_BOOK = Nothing
End Sub
|
|
アクア
- 10/9/13(月) 20:12 -
