我是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
感谢您的帮助。我真的很感激。
答案 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`