返回列表 上一主題 發帖

[發問] 1張主工作表篩選後新增工作表及命名

  1. Sub zz()
  2. Application.ScreenUpdating = 0
  3. Dim rng As Range, d As Object, ws As Worksheet
  4. Set ws = ActiveSheet
  5. ws.AutoFilterMode = False
  6. c = [a3].CurrentRegion.Columns.Count
  7. Set d = CreateObject("scripting.dictionary")
  8. Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(3).Row, c))
  9. a = rng.Columns(3)
  10. For i = 2 To UBound(a)
  11.     d(a(i, 1)) = ""
  12. Next
  13. k = d.keys
  14. For i = 0 To UBound(k)
  15.     ws.Copy after:=Sheets(Sheets.Count)
  16.     ActiveSheet.AutoFilterMode = False
  17.     [a3].CurrentRegion.Clear
  18.     With ws
  19.         rng.AutoFilter Field:=3, Criteria1:=k(i)
  20.         .[a3].CurrentRegion.Copy [a3]
  21.         
  22.     End With
  23.     ActiveSheet.Name = [c6].Value
  24. Next
  25. Application.ScreenUpdating = 1
  26. End Sub
複製代碼

TOP

檔案無法打開

TOP

代碼不要放入sheets內。

複本 new.zip (35.12 KB)

TOP

        靜思自在 : 一個人的快樂.不是因為他擁有得多,而是因為他計較得少。
返回列表 上一主題