| |
▼アクア さん：
>「2010_a」をAAA.xlsというシート名、「2010_b」を
>AAA.xls_2というシート名、「2010_b」をAAA.xls_3というシート名がふられるように決めました。
>しかし、この添え字が順次ふられる部分をどう書いていいものか分からず困っています。
すでに問題点の開示がありますが、
サンプルコードを書いてみたので、参考にしてください。
ただし、下のコードは AAA.xls の
「2010_a」を【AAA】というシート名、
「2010_b」を【AAA_2】というシート名、
「2010_c」を【AAA_3】というシート名にしています。
Sub 集約2()
Dim myPath As String
Dim MergeBOOK As Workbook
Dim mergeBOOKname As String
Dim opnBOOK As Workbook
Dim bookName As String
Dim sheetName As String
Dim nSheet As Long
Dim wsheet As Worksheet
Dim i As Long
'パスとファイル名
myPath = "E:\(Data)\TempBook\" '\Practice"
mergeBOOKname = "集約.xls"
Set MergeBOOK = Workbooks.Add(xlWBATWorksheet) 'シート1枚のBook
'PATH内全ブックの取得
bookName = Dir$(myPath & "*.xls")
Do While bookName <> ""
'すべてのブックの先頭シートを新規ブックにコピー
If bookName <> mergeBOOKname Then
Set opnBOOK = Workbooks.Open(myPath & bookName)
With MergeBOOK.Worksheets
sheetName = Replace(LCase$(opnBOOK.Name), ".xls", "")
nSheet = 0
For Each wsheet In opnBOOK.Worksheets
If wsheet.Name Like "2010*" Then
'2010から始まる名前のシートをコピーする
wsheet.Copy After:=.Item(.Count)
'◆追加したシートの名前を元のブック名+連番とする
nSheet = nSheet + 1
.Item(.Count).Name = _
Replace(sheetName, vbTab, "_" & nSheet)
If InStr(sheetName, vbTab) = 0 Then
sheetName = sheetName & vbTab
End If
End If
Next
opnBOOK.Close SaveChanges:=False
End With
End If
bookName = Dir$()
Loop
Application.DisplayAlerts = 0
MergeBOOK.Worksheets(1).Delete
Application.DisplayAlerts = True
'新規ブックを保存する
With MergeBOOK
.SaveAs myPath & mergeBOOKname
If MsgBox("閉じますか？", vbOKCancel, mergeBOOKname) = vbOK Then
.Close
End If
End With
End Sub
|
|
kanabun
- 10/9/13(月) 21:30 -
