|
发表于 2017-7-16 16:40
|
显示全部楼层
本楼为最佳答案
- Sub tt()
- Dim arr, i%, y%, Mypath$, Wb$
- Application.ScreenUpdating = False
- Mypath = ThisWorkbook.Path & ""
- If Dir(Mypath & "IP新文件夹", vbDirectory) = "" Then MkDir Mypath & "IP新文件夹"
- Wb = Dir(Mypath & "*.xls*")
- Do While Wb <> ""
- If InStr(Wb, ThisWorkbook.Name) = 0 Then
- Workbooks.Open Mypath & Wb
- arr = Sheet1.UsedRange
- ActiveWorkbook.Close False
- Else
- arr = Sheet1.UsedRange
- End If
-
- For i = 1 To UBound(arr)
- For y = 1 To UBound(arr, 2)
- If arr(i, y) = "IP" Then
- Workbooks.Add
- With ActiveWorkbook
- .Sheets(1).Range("a1").Resize(UBound(arr)) = Application.Index(arr, , y)
- .SaveAs Mypath & "IP新文件夹" & Format(Now(), "hhmmss") & Wb
- .Close True
- End With
- GoTo 100
- End If
- Next y, i
- 100:
- Wb = Dir
- Loop
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|