|
楼主 |
发表于 2015-4-20 17:00
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub tobook()
- Dim dic As Object
- Dim i As Integer, j As Integer
- Dim t As Variant
- Dim wb As Workbook
- Dim tb As Workbook
- Dim pt As String
- Dim ys As Worksheet
- Dim sht As Worksheet
- Set dic = CreateObject("scripting.dictionary")
- r = [c65536].End(xlUp).Row
- Set tb = ThisWorkbook
- Set ys = ActiveSheet
- pt = ThisWorkbook.Path
- For i = 2 To r
- dic(Cells(i, 3).Value) = ""
- Next i
- t = dic.Keys
- For j = 0 To dic.Count - 1
- Set wb = Workbooks.Add
- Set sht = ActiveSheet
- sht.Range("a1:g1") = Array("工号", "姓名", "部门", "籍贯", "出生年月", "民族", "性别")
- For i = 2 To r
- If ys.Cells(i, 3).Value = t(j) Then
- ys.Cells(i, 3).Offset(, -2).Resize(1, 7).Copy sht.Range("a65536").End(xlUp).Offset(1, 0)
- End If
- Next i
- wb.SaveAs Filename:=pt & "" & t(j)
- wb.Close
- Next j
- End Sub
复制代码 |
|