|
- Sub test()
- Dim r%, i%
- Dim arr, brr
- Dim wb As Workbook
- Dim wb1 As Workbook
- Dim ws As Worksheet
- Dim mypath$, myname$
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- mypath = ThisWorkbook.Path & "\原文件"
- myname = Dir(mypath & "*.xls")
- Do While myname <> ""
- Set wb = GetObject(mypath & myname)
- With wb
- With .Worksheets("sheet1")
- r = .Cells(.Rows.Count, 3).End(xlUp).Row
- arr = .Range("c2:h" & r - 1)
- Application.SheetsInNewWorkbook = 1
- Set wb1 = Workbooks.Add
- With wb1
- With .Worksheets(1)
- .Range("a1").Resize(UBound(arr), 1) = Application.Index(arr, 0, 1)
- .Range("c1").Resize(UBound(arr), 1) = Application.Index(arr, 0, 6)
- End With
- .SaveAs Filename:=ThisWorkbook.Path & "\转换后文件" & Split(myname, ".")(0) & "导入", FileFormat:=xlExcel8
- .Close False
- End With
- End With
- .Close False
- End With
- myname = Dir
- Loop
- End Sub
复制代码 |
|