Excel VBA:如何使用相同的按钮运行两个代码

时间:2015-05-14 21:48:28

标签: excel vba excel-vba

我是VBA的新手,我真的需要你的帮助。我想用相同的按钮运行以下单独的代码(一个代码将工作表中的信息复制到另一个代码,另一个代码根据最后复制的单元格添加复选框和数据):

Sub CopyInfo()
Dim i As Integer
Dim LastRow As Integer
Dim Search As String
Dim Column As Integer

Sheets("Audit").Activate
Sheets("Audit").Range("A1").Select
'Sets an Autofilter to sort out only your Yes rows.
Selection.AutoFilter
'Change Field:=5 to the number of the column with your Y/N.
 Sheets("Audit").Range("$A$1:$G$2000").AutoFilter Field:=5,   Criteria1:="Yes"

'Finds the last row
 LastRow = Sheets("Audit").Cells(Sheets("Audit").Rows.Count, "A").End(xlUp).Row

i = 1
'Change the 3 to the number of columns you got in Sheet2
 Do While i <= 3
 Search = Sheets("Form").Cells(1, i).Value
 Sheets("Audit").Activate
 'Update the Range to cover all your Columns in Sheet1.
 If IsError(Application.Match(Search, Sheets("Audit").Range("A1:G1"), 0)) Then
    'nothing
 Else
    Column = Application.Match(Search, Sheets("Audit").Range("A1:G1"), 0)
    Sheets("Audit").Cells(2, Column).Resize(LastRow, 1).Select
    Selection.Copy
    Sheets("Form").Activate
    Sheets("Form").Cells(2, i).Select
    ActiveSheet.Paste
 End If
 i = i + 1
Loop
End Sub

Sub Checkbox()
 Dim ToRow As Long
 Dim LastRow As Long
 Dim MyLeft As Double
 Dim MyTop As Double
 Dim MyHeight As Double
 Dim MyWidth As Double
'--------------------------
 LastRow = Range("A65536").End(xlUp).Row
 For ToRow = 2 To LastRow
     If Not IsEmpty(Cells(ToRow, "A")) Then
        '-
        MyLeft = Cells(ToRow, "C").Left
        MyTop = Cells(ToRow, "C").Top
        MyHeight = Cells(ToRow, "C").Height
        MyWidth = MyHeight = Cells(ToRow, "C").Width
        '-
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
         With Selection
            .Caption = "Yes"
            .Value = xlOff
            .LinkedCell = "E" & ToRow
            .Display3DShading = False
         End With
     End If
     Next
     End Sub

感谢您的帮助。我真的很感激。

1 个答案:

答案 0 :(得分:4)

您需要将两个程序(Sub)称为第三个程序:

Sub Copysheet_And_CheckBox() '<-- you run this
  Copysheet '<-- you call this first
  Checkbox '<-- and this second into the same call
End Sub`