| |
（‘ -‘ ）えりわかったわ！シート名をつける位置がよろしくないわ！
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
（‘ -‘ ）ためしてないから不具合がでたら自分で改編してちょうだい！
|
|
えり
- 10/9/13(月) 20:35 -
