|
(‘ -‘ )えりわかったわ!シート名をつける位置がよろしくないわ!
dim a
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
a = 1
'2010から始まる名前のシートをコピーする
If Mid(.Worksheets(Sheet_No).Name, 1, 4) = "2010" Then
.Worksheets(Sheet_No).Copy after:=MERGE_BOOK.Worksheets(MERGE_BOOK.Worksheets.Count)
If a = 1 Then
MERGE_BOOK.Worksheets(MERGE_BOOK.Worksheets.Count).Name = .Name
Else
MERGE_BOOK.Worksheets(MERGE_BOOK.Worksheets.Count).Name = .Name & a
End If
a = a + 1
End If
Next
'立ち上げたブック(既存のフォルダ内)を保存せず閉じる
.Close savechanges:=False
End With
End If
PATH_BOOK_NAME = Dir()
Loop
(‘ -‘ )ためしてないから不具合がでたら自分で改編してちょうだい!
|
|