|
こんにちは。
Sub Test3()
Dim myf As Variant
Dim MyB As Workbook
Dim i As Integer, bcnt As Integer, SCnt As Integer
Dim sNo As Integer '対象シート番号
Dim fname As Worksheet
With Application
myf = .GetOpenFilename("エクセルブック(*.xls),*.xls", , , , True)
If VarType(myf) = 11 Then Exit Sub
bcnt = UBound(myf)
SCnt = .SheetsInNewWorkbook
.SheetsInNewWorkbook = bcnt
.ScreenUpdating = False
End With
Set MyB = Workbooks.Add
For i = 1 To bcnt
Workbooks.Open myf(i)
'いま開いたブックのシートを見て回る
For sNo = 1 To Worksheets.Count
'Like演算子で比較
If Worksheets(sNo).Name Like "内訳書*" Then
Exit For
End If
Next
If sNo <= Worksheets.Count Then
'見つかった場合
ActiveWorkbook.Worksheets(sNo) _
.Cells.Copy MyB.Worksheets(i).Range("A1")
End If
ActiveWorkbook.Close False
Next i
With Application
.SheetsInNewWorkbook = SCnt
.ScreenUpdating = True
End With
Set MyB = Nothing
End Sub
こんな感じでどうでしょうか?
|
|