[µo°Ý] «ö¦W³æ¤Îªí®æ½d¥»·s¼W¤u§@ªí

missbb

¦Ñ®v¦n,¦³¤u§@ªí¬O"¦W³æ", ¥t¦³¤u§@ªí"ªí®æ½d¥»", ½Ð°Ý¦p¦ó¥ÎVBA¼g¥X, «ö"¦W³æ"·s¥[¤u§@ªí, ¤u§@ªí¦WºÙ¬O"¦W³æ"²Ä1¦æ, ¦Ó¤u§@ªí¤º®e¬O"ªí®æ½d¥»"??

¦³³Ò½ç±Ð «ö¦W³æ¤Îªí®æ½d¥»·s¼W¤u§@ªí.zip (18.14 KB)

¤U¸ü¦¸¼Æ: 8

2016-11-6 00:02

missbb

¦hÁ«ü¾É. §Ú¦Û¤v«ä¦Ò¤F¤@­Ó¤èªk·s¼W¤u§@ªí.  ¦ý·Q¥ÎFILTER, ¥ÎINPUT BOX°Ý­n·s¼W¨º¤@­Ó³¡ªùªº¤u§@ªí, ¦p¿é¤JACC, «h¥u·s¼WACCªº¤u§@ªí. ³oÀ³¦p¦ó°µ??? VBA ¥Ó½ÐªíV5.zip (20.32 KB)

¤U¸ü¦¸¼Æ: 5

2016-11-7 23:50

1. Sub copytosheetok2()
   
2. 
   
3. Dim MyCell As Range, MyRange As Range
   
4. 
   
5. Set MyRange = Sheets("list").Range("A2")
   
6. Set MyRange = Range(MyRange, MyRange.End(xlDown))
   
7. 
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10. 
    
11. For Each MyCell In MyRange
    
12.    
    
13.    
    
14. Sheets("form").Copy After:=Sheets(Sheets.Count) 'Create a new worksheet
    
15. 
    
16. Sheets(Sheets.Count).Name = MyCell.Value 'Renames the new worksheets
    
17. 
    
18. For i = 3 To Sheets.Count
    
19.         With Sheets(i).Range("A1:E7")
    
20.                  .Value = .Value
    
21.         End With
    
22.    
    
23.           With Sheets(i).Range("A10:B11")
    
24.                  .Value = .Value
    
25.         End With
    
26.     Next i
    
27. 
    
28. Next MyCell
    
29.    Application.ScreenUpdating = True
    
30.     Application.DisplayAlerts = True
    
31. 
    
32. 
    
33. End Sub

½Æ»s¥N½X

¦^´_ 2# ­ã´£³¡ªL

missbb

¦^´_ 3# missbb

¥i¦p¦ó¥[¤J¤U¦CCODE, FILTER«á¤~·s¼W¤u§@ªí:
Input box : ¿é¤J³¡ªù
¨Ò¦p:ACC ©Î¥þ³¡
sheets("list").Select
ActiveSheet.Range("$A$1:$Z$1048576").AutoFilter Field:=2, Criteria1:="ACC"
¥u·s¼W³¡ªù¬OACCªº¤u§@ªí
.......¤£À´¦p¦ó±µ¤U¥h.....

missbb

¦^´_ 5# Kubi

¦ý¤@«öHRA¥u¦L¥X¤@¥÷HRA, ¥i§_«öHRA, ©Ò¦³HRA·|¦L¥X?

missbb

¦^´_ 7# Kubi

¦³³Ò赐±Ð

missbb

¦^´_ 7# Kubi

§A¦n, §Ú¤S¸Õ¤F¿z¿ïLISTªº³¡ªù¬OHRA, ¦ACOPY ¥u¦³³¡ªù¬OHRAªº¤u§@ªí, ¦ý¤S¬O¥þ³¡³£COPY¥X¤u§@ªí(HRA, ACC) VBA ¥Ó½ÐªíV1 original (2).zip (22.91 KB)

¤U¸ü¦¸¼Æ: 1

2016-11-10 22:30

, ½Ð°Ý¤U¦CCODE¦³¬Æ»ò¤í¯Ê?
Sub copytosheetok3()


Dim Rng As Range        
Dim theRow As Range     
Dim theArea As Range      
    With Sheets("list")      
        Set Rng = .UsedRange   
        Rng.AutoFilter Field:=2, Criteria1:="HRA"     '¿z¿ï
            Set Rng = Rng.Resize(Rng.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
    End With

Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("list").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

For Each MyCell In MyRange
        
Sheets("form").Copy after:=Sheets(Sheets.Count) 'Create a new worksheet

Sheets(Sheets.Count).Name = MyCell.Value 'Renames the new worksheets

For i = 3 To Sheets.Count
        With Sheets(i).Range("A1:E7")
                 .Value = .Value
        End With
   
          With Sheets(i).Range("A10:B11")
                 .Value = .Value
        End With
    Next i

Next MyCell
   Application.ScreenUpdating = True
    Application.DisplayAlerts = True


End Sub