代码的功能正确运行，但是做成按钮却不能运行，这是为什么

charlesrao

我有一段代码，实现的是：打开任意一个xls文档，然后模块中插入这段代码，运行，就可以浏览文件夹打开想要被按内容拆分的excel文档，然后选择保留几行表头，按哪一列拆分。这个代码多次测试都无误。但是我插入一个按钮，将代码复制进去之后，操作同样的文件却出错，这是什么原因？那个按钮自带Private Sub OptionButton1_Click() 我把自己的sub 和 end都删除了的

1. Sub 拆分表()
   
2. Application.ScreenUpdating = False
   
3. Dim clm_d  As Integer
   
4. Dim mycell As Range
   
5. Dim nodupes As New Collection
   
6. Dim rngop As Range
   
7. Set ac = ActiveSheet
   
8. Dim myr As Range
   
9. Dim lastrow As Integer
   
10. Dim myr1 As Range
    
11. Dim baoliu As Integer
    
12. Dim acn As String
    
13. Dim st As String
    
14. Dim st1 As String
    
15. st = Application.GetOpenFilename
    
16. Workbooks.Open (st)
    
17. st1 = ActiveWorkbook.Path
    
18. baoliu = Application.InputBox(prompt:="在有几个sheet情况下，将页面转到要拆分的sheet再操作，要保留几行表头？（注意隐藏行）", Title:="选择所要保留的表头", Type:=1)
    
19. 
    
20. clm_d = Application.InputBox(prompt:="要按哪一列拆分？(注意隐藏列）", Title:="选择拆分列", Type:=1)
    
21. 
    
22. acn = ActiveSheet.Name
    
23. Set myr = activesheet.Range(Cells(1, 1), Cells(baoliu, Application.WorksheetFunction.Max(Range("A1").End(xlToRight).Column, Range("A2").End(xlToRight).Column)))
    
24. 
    
25. myr.Copy Destination:=rangePasteSpecial
    
26. Sheets.Add after:=ActiveSheet
    
27. ActiveSheet.Name = "辅助"
    
28. ActiveSheet.Paste
    
29. Set myr1 = ActiveSheet.Range(Cells(1, 1), Cells(baoliu, Application.WorksheetFunction.Max(Range("A1").End(xlToRight).Column, Range("A2").End(xlToRight).Column)))
    
30. 
    
31. Worksheets(acn).Activate
    
32. For Each mycell In activesheet.Range(Cells(baoliu + 1, clm_d), (activesheet.Cells(baoliu + 1, clm_d).End(xlDown)))
    
33. On Error Resume Next
    
34.   nodupes.Add mycell.Value, CStr(mycell.Value)
    
35. On Error Resume Next
    
36. Next mycell
    
37. On Error GoTo 0
    
38. 
    
39. 
    
40. Set rngop = Worksheets(acn).UsedRange
    
41. For Each Item In nodupes
    
42. rngop.AutoFilter Field:=clm_d, Criteria1:=Item
    
43. rngop.Copy
    
44. Sheets.Add after:=ActiveSheet
    
45. ActiveSheet.Name = Item
    
46. ActiveSheet.Paste Destination:=Worksheets(Item).Range(Cells(baoliu + 1, 1), Cells(baoliu + 1, 1).End(xlDown))
    
47. Rows(baoliu + 1).Delete
    
48. Worksheets("辅助").Activate
    
49. 
    
50. myr1.Copy Destination:=rangePasteSpecial
    
51. 
    
52. Worksheets(Item).Activate
    
53. 
    
54. Range(Cells(1, 1), Cells(baoliu, Application.WorksheetFunction.Max(Range("A1").End(xlToRight).Column, Range("A2").End(xlToRight).Column))).Select
    
55. ActiveSheet.Paste
    
56. 
    
57. Next Item
    
58. 
    
59. rngop.AutoFilter
    
60. Worksheets(acn).Activate
    
61. Application.ScreenUpdating = True
    
62. 
    
63. Dim sht As Worksheet
    
64.   
    
65.   Application.ScreenUpdating = False
    
66.   Application.DisplayAlerts = False
    
67.   Worksheets("辅助").Delete
    
68.   Worksheets(acn).Delete
    
69.   For Each sht In Sheets
    
70.   If IsEmpty(sht.UsedRange) Then
    
71.   sht.Delete
    
72.   Else
    
73.   sht.Copy
    
74.   ActiveWorkbook.SaveAs Filename:=st1 & "" & sht.Name & ".xls"
    
75.   ActiveWorkbook.Close
    
76.   End If
    
77.   Next
    
78. 
    
79.   Application.DisplayAlerts = True
    
80.   Application.ScreenUpdating = True
    
81. End Sub

复制代码

蓝桥玄霜

没有表格附件不能测试代码。