Question

VBA代码：将数据复制到另一表中符合条件的行

sheet1表中，在B3输入张三，c3金额，能在sheet2表中自动找到张三对应的行第一个空榕（最后一个非空列+1列），自动复制金额，求各位老师给个代码，谢谢

Answer 1

用sql方法实现的，你的sheet1的F1单元格，有个空格需要删除，还有sheet2每列的单元格格式需要先设定一下

Option Explicit

Private Sub CommandButton1_Click()

Dim sql As String

Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Sheets("Sheet2").Range("A2:F65536") = ""

conn.Provider = "Microsoft.Jet.OLEDB.4.0"
conn.ConnectionString = "Data Source=" + ThisWorkbook.FullName + ";" + "Extended Properties=Excel 8.0;"
conn.Open

sql = "SELECT 日期, 供货商, 材料料号, 品名, 数量, 欠款金额 " & _
"FROM [Sheet1$] " & _
"WHERE 欠款金额 IS NOT NULL"

rs.Open sql, conn, adOpenKeyset, adLockOptimistic

Sheets("Sheet2").Cells(2, 1).CopyFromRecordset rs

rs.Close
conn.Close

Set rs = Nothing
Set conn = Nothing

MsgBox "ok"

End Sub

Answer 2

右击要填金额的表单（就是输入张三和金额的表单），查看代码，将以下代码复制进去即可实现
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Row = 3 And Target.Column = 3 Then
If Cells(3, 2) = "" Then
MsgBox "B3没有填名字!"
Exit Sub
End If
mz = Cells(3, 2)
a = Sheets("名字表").[a65536].End(xlUp).Row '你要操作的表格,表明自己改
ar = Sheets("名字表").Range("a1:a" & a)
For i = 2 To a
If ar(i, 1) = mz Then
k = i
i = a
End If
Next
b = Sheets("名字表").Cells(k, 255).End(xlToLeft).Column
Sheets("名字表").Cells(k, b + 1) = Target.Value
End If
End If
End Sub

追问

你好，我在指定宏时找不到这个宏

追答

不是录制宏 你直接右击sheet1然后点击查看代码。直接复制进去就好

我说sheet1说的是你要操作的表。并不是说真的sheet1表

这个复制完后 你在c3输入金额它就会自动把金额录到你要的表名字后面。不需要任何按钮之类的东西。如果你要点击一下再过去请追问