ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¿z¿ï«á·s¼W¤u§@ªí

[µo°Ý] ¿z¿ï«á·s¼W¤u§@ªí

¥»©«³Ì«á¥Ñ missbb ©ó 2016-11-14 19:56 ½s¿è

§Ú¸ÕÅç¦C³Ì«á¤@¨B¤F, ´N¬O¥i¥H¥Î³¡ªù©Î­û¤u½s¸¹¿z¿ï, ¦b¿z¿ï³¡ªù¬O§¹¥þµL°ÝÃD, ¦ýÂk¿ï­û¤u½s¸¹, ¤S¦h¥X¤@±i¤u§@ªí, ·Q¨Ó·Q¥h·Q¤£³q, ½Ð¤j¤jÀ°¦£:'(

VBA ¥Ó½Ðªí 20161114v1 (2).zip (19.07 KB)
  1. Sub copytosheetok02()
  2. 'step select dept -> create appraisal form based on sheet result

  3. With Sheets("list").Activate

  4. Dim yn As Integer

  5. yn = MsgBox(prompt:="¦pªG¿z¿ï³¡ªù, ½Ð«ö¬O", Buttons:=vbYesNo + vbQuestion)
  6. If yn = vbYes Then

  7.     dept = InputBox("¿z¿ï³¡ªù:")
  8.     Range("a1").AutoFilter Field:=2, Criteria1:=dept
  9.     ActiveSheet.UsedRange.Select
  10.     Selection.copy
  11.     Sheets.Add After:=Sheets(Sheets.Count)
  12.     Sheets(Sheets.Count).Name = "result"
  13.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  14.         xlNone, SkipBlanks:=False, Transpose:=False
  15.         
  16. Else
  17.     ID = InputBox("¿z¿ï½s¸¹:")
  18.     Range("a1").AutoFilter Field:=1, Criteria1:=ID
  19.     ActiveSheet.UsedRange.Select
  20.     Selection.copy
  21.     Sheets.Add After:=Sheets(Sheets.Count)
  22.     Sheets(Sheets.Count).Name = "result"
  23.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  24.         xlNone, SkipBlanks:=False, Transpose:=False

  25. End If

  26. End With

  27. Dim MyCell As Range, MyRange As Range

  28. Set MyRange = Sheets("result").Range("A2")
  29. Set MyRange = Range(MyRange, MyRange.End(xlDown))

  30.     Application.ScreenUpdating = False
  31.     Application.DisplayAlerts = False

  32. For Each MyCell In MyRange
  33. Sheets("form").copy After:=Sheets(Sheets.Count) 'Create a new worksheet
  34. [color=Red]Sheets(Sheets.Count).Name = MyCell.Value 'Renames the new worksheet[/color]s
  35. '¥D­n°ÝÃD´N¥X¦b³o¥y¤F??????

  36. For i = 4 To Sheets.Count
  37.         With Sheets(i).Range("A1:E7")
  38.                  .Value = .Value
  39.         End With
  40.    
  41.           With Sheets(i).Range("A10:B11")
  42.                  .Value = .Value
  43.         End With
  44.     Next i
  45. Next MyCell

  46.     Application.ScreenUpdating = True
  47.     Application.DisplayAlerts = True

  48. End Sub
½Æ»s¥N½X

37¦æ§ï¬°
  1. Set MyRange = Sheets("result").Range("A2")
  2. If MyRange.Count > 1 Then Set MyRange = Range(MyRange, MyRange.End(xlDown))
½Æ»s¥N½X

TOP

©êºp,¼Ó¤W¬O¿ùªº37¦æ¬O
  1. If yn = vbYes Then Set MyRange = Range(MyRange, MyRange.End(xlDown))
½Æ»s¥N½X

TOP

RE: ¿z¿ï«á·s¼W¤u§@ªí

¦^´_ 3# ¸­°ê¬w

·PÁÂ!:lol

TOP

        ÀR«ä¦Û¦b : ¦Û¤v®`¦Û¤v¡A²ö¹L©ó¶ÃµoµÊ®ð¡C
ªð¦^¦Cªí ¤W¤@¥DÃD