|
検証してないので、動かなかったらごめんなさい。
Sub Test3()
Dim myf As Variant
Dim MyB As Workbook, OpWB As Workbook, WS As Worksheet
Dim i As Integer, bcnt As Integer, SCnt As Integer
Dim fname As Worksheet
With Application
myf = .GetOpenFilename("エクセルブック(*.xls),*.xls", , , , True)
If VarType(myf) = 11 Then Exit Sub
End With
Ct = 0
For Each st In myf
Set OpWB = Workbooks.Open(st)
For Each WS In OpWB.Sheets
If WS.Name Like "内訳書*" Then
If MyB.Sheets.Count <= Ct Then
MyB.Worksheets.Add after:=Worksheets(MyB.Worksheets.Count)
End If
Ct = Ct + 1
WS.UsedRange.Copy MyB.Sheets(Ct).Range(WS.UsedRange.Address)
DoEvents
End If
Next
OpWB.Close (False)
Set OpWB = Nothing
Next
With Application
.ScreenUpdating = True
End With
Set MyB = Nothing
End Sub
|
|