Advertisement
Guest User

Untitled

a guest
Feb 23rd, 2020
93
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.14 KB | None | 0 0
  1. Private Sub UserForm_Click()
  2.  
  3. End Sub
  4.  
  5. Private Sub CommandButton1_Click()
  6. Range("A1:Y50506").Select
  7. Selection.Copy
  8. Sheets.Add After:=ActiveSheet
  9. Sheets("Foglio2").Select
  10. Sheets("Foglio2").Name = "Script"
  11. ActiveSheet.Paste
  12. End Sub
  13.  
  14. Private Sub CommandButton2_Click()
  15. Range("B6:B372").Select
  16. ActiveWorkbook.Worksheets("Script").Sort.SortFields.Clear
  17. ActiveWorkbook.Worksheets("Script").Sort.SortFields.Add Key:=Range("B6:B372") _
  18. , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
  19. "A01,A02,A03,A04,A05,A06,A07,A08,A09,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23,A24,A25,A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38,A39,A40,A41,A42,A43,A44,A45,A46,A47,A48,A49,A50,A51,A52,A53,A54,A55,A56,A57,A58,A59,A60,A61,A62,A63,A64" _
  20. , DataOption:=xlSortNormal
  21. With ActiveWorkbook.Worksheets("Script").Sort
  22. .SetRange Range("B6:B372")
  23. .Header = xlGuess
  24. .MatchCase = False
  25. .Orientation = xlTopToBottom
  26. .SortMethod = xlPinYin
  27. .Apply
  28. End With
  29. ActiveWindow.SmallScroll Down:=-12
  30. End Sub
  31.  
  32.  
  33. Private Sub CommandButton3_Click()
  34. AggA10
  35. End Sub
  36.  
  37. Private Sub AggA10()
  38. Dim i, ii As Long
  39. Dim S As String
  40. S = "A0"
  41. Dim na, ng, nd, nh, ne, nf As Integer
  42. na = 1
  43. For i = 1 To 5000 Step 1
  44. If Cells(i, "B").Value Like "*A0" & na & "*" Then
  45. Cells(i, "B").EntireRow.Insert
  46. Cells(i, "B").Value = "A0" & na
  47. na = na + 1
  48. End If
  49.  
  50. Next
  51. AggA100
  52. End Sub
  53.  
  54. Private Sub AggA100()
  55. Dim i, ii As Long
  56. Dim S As String
  57. Dim na, ng, nd, nh, ne, nf As Integer
  58. na = 10
  59. For i = 1 To 5000 Step 1
  60. If Cells(i, "B").Value Like "*A" & na & "*" Then
  61. Cells(i, "B").EntireRow.Insert
  62. Cells(i, "B").Value = "A0" & na
  63. na = na + 1
  64. End If
  65.  
  66. Next
  67. AggA09
  68. End Sub
  69.  
  70. Private Sub AggA09()
  71. Dim i, ii As Long
  72. Dim S As String
  73. Dim na, ng, nd, nh, ne, nf As Integer
  74. na = 10
  75. For i = 1 To 5000 Step 1
  76. If Cells(i, "B").Value Like "*A09*" Then
  77. Cells(i, "B").EntireRow.Insert
  78. Cells(i, "B").Value = "A09"
  79. na = na + 1
  80. End If
  81.  
  82. Next
  83.  
  84. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement