[µo°Ý] 1±i¥D¤u§@ªí¿z¿ï«á·s¼W¤u§@ªí¤Î©R¦W

missbb

sub copyfile()
'±NDATA¤u§@ªí¤º«ö³¡ªù¿z¿ï«á¥t¦s¤u§@ªí

1. For i = 1 To 3
   
2. Cells(1, 1).AutoFilter 3, i
   
3. Cells(1, 1).CurrentRegion.Copy '³o¼Ë¥X¿ù, ¥u¥i±N³¡¥÷¤º®e¥t¦s¤u§@ªí
   
4. Worksheets.Add after:=Worksheets(Worksheets.Count) 1¤u§@ªí¿z¿ï«á¥t¦s¤u§@ªí¤Î¥H¿z¿ïµ²ªG©R¦W.zip (28.96 KB)
   ¤U¸ü¦¸¼Æ: 2
   

   2018-6-8 23:24
   
   
5. Worksheets(Worksheets.Count).Name = "SHEET" & i
   
6. ActiveSheet.Paste
   
7. Application.CutCopyMode = False
   
8. Sheets(1).Select
   
9. ActiveSheet.ShowAllData
   
10. Next i
    
11. ActiveSheet.AutoFilterMode = False
    
12. End Sub
    
13. 
    
14. 
    
15. Sub myName() '¥Î¨C¤u¤´ªíªºC6Àx¦s®æ¬°¤u§@ªí©R¦W
    
16. For i = 2 To Worksheets.Count
    
17. Worksheets(i).Name = Worksheets(i).Cells(2, 1)
    
18. Next
    
19. End Sub

½Æ»s¥N½X

ikboy

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

½Æ»s¥N½X

missbb

¦^´_ 2# ikboy
·PÁÂ, §Ú­n¬¨¤Æ¤Î¾Ç²ß.:D

missbb

¤j¤jIKBOY§A¦n, §Ú±N§A«ü¾Éªº©ñ¤J¸û¦h¸ê®ÆªºEXCEL, ¦Û¤v¥[¤JÀ˵ø¸ê®Æªº§ï°Ê.  ¦ý°õ¦æ®É¥X²{1004ªº¿ù»~, ½ÐÀ°¦£¬Ý¨º¸Ì¥X¿ù?

§Ú¬O­n¦bSHEET DATA¤§«á, «O¯d¤u§@ªí1¤Î¤u§@ªí¤G,§Y¤À³¡ªù·s¼Wªº¤u§@ªí, ¬O­n¦b¤u§@ªí¤G¤§«á·s¼W.

new.zip (37.07 KB)

¤U¸ü¦¸¼Æ: 2

2018-6-11 19:30

1. Sub sortingsavesheet2()
   
2. 'use this , sorting dept then save individualsheet with deptname
   
3. 
   
4. Application.ScreenUpdating = 0
   
5. Dim rng As Range, d As Object, ws As Worksheet
   
6. Set ws = ActiveSheet
   
7. ws.AutoFilterMode = False
   
8. c = [a3].CurrentRegion.Columns.Count
   
9. Set d = CreateObject("scripting.dictionary")
   
10. Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(3).Row, c))
    
11. a = rng.Columns(3)
    
12. For i = 2 To UBound(a)
    
13.     d(a(i, 1)) = ""
    
14. Next
    
15. k = d.keys
    
16. For i = 0 To UBound(k)
    
17.     ws.Copy after:=Sheets(Sheets.Count)
    
18.     ActiveSheet.AutoFilterMode = False
    
19.     [a3].CurrentRegion.Clear
    
20.     With ws
    
21.         rng.AutoFilter Field:=3, Criteria1:=k(i)
    
22.         .[a3].CurrentRegion.Copy [a3]
    
23.         
    
24.     Range("F6").Select
    
25.     With ActiveWindow
    
26.         .SplitColumn = 5
    
27.         .SplitRow = 5
    
28.     End With
    
29.     ActiveWindow.FreezePanes = True
    
30.       
    
31.     End With
    
32.       
    
33.     ActiveSheet.Name = [c6].Value
    
34. Next
    
35. Application.ScreenUpdating = 1
    
36. 
    
37. With Sheets("data").Activate
    
38.     If ActiveSheet.FilterMode Then
    
39.       ActiveSheet.ShowAllData
    
40.     End If
    
41. [color=Red]'¦Û¦æ¥[¤J­áµ²µ¡¤Î³Ì«áªð¦^DATAªºF6[/color]  
    
42. Range("F6").Select
    
43. With ActiveWindow
    
44.         .SplitColumn = 5
    
45.         .SplitRow = 5
    
46.     End With
    
47.     ActiveWindow.FreezePanes = True
    
48.    
    
49. End With
    
50. End Sub

½Æ»s¥N½X

¦^´_ 2# ikboy

ikboy

ÀÉ®×µLªk¥´¶}

missbb

½Æ¥» new.zip (30.05 KB)

¤U¸ü¦¸¼Æ: 1

2018-6-12 20:57

¸É¦^ªþ¥ó:P
¦^´_ 5# ikboy

ikboy

¥N½X¤£­n©ñ¤Jsheets¤º¡C

missbb

·PÁ¨ó¤O