如果满足条件，Excel VBA 将数据复制到表中答案

【问题标题】：Excel VBA copy data into table if condition is met如果满足条件，Excel VBA 将数据复制到表中
【发布时间】：2020-11-20 19:41:26
【问题描述】：

我创建了以下代码，理论上应该将活动工作表中的某些单元格复制到工作表名称“清单 - 审核”中。 “Checklist-audit”包含一个表，如果 A 列中已经存在值“KPI_Month”，我只希望它复制并过去。

请看下面的代码：


SheetName = ActiveSheet.Select

KPI_Month = ActiveSheet.Range("N2").Value
KPI_QC_Score = ActiveSheet.Range("I10").Value
KPI_Score_Difference = ActiveSheet.Range("P1").Value
KPI_QC = ActiveSheet.Range("N11").Value
KPI_QC_Role = ActiveSheet.Range("N12").Value
KPI_Date_Stamp = Now()

Sheets("Checklist - Audit").Activate

lrow = Range("A1100").End(xlUp).Row + 1

Cells(lrow, 1).Activate

If Cells(lrow, 1) = KPI_Month Then

Cells(lrow, 5) = KPI_QC_Score
Cells(lrow, 6) = KPI_Score_Difference
Cells(lrow, 9) = KPI_QC
Cells(lrow, 10) = KPI_QC_Role
Cells(lrow, 11) = KPI_Date_Stamp

Else

MsgBox "Reviewer must submit first"


End If

我的问题是它不是复制和粘贴而是自动弹出消息框。此外，如果要复制和粘贴，则应在找到月份的同一行进行。

谁能解释一下代码哪里出了问题，并指导我找到解决方案。

非常感谢。

【问题讨论】：

lrow 是 A 列中最后一个单元格正下方的单元格的行号，这意味着它始终为空。除非KPI_Month 是一个空字符串，否则Cells(lrow, 1) = KPI_Month 怎么会是True？
什么是单元格A1100？这是桌子的尽头吗？还是您用来获取表格末尾的 A 列下方的单元格？
另外，从描述中，您需要遍历表格以识别那些“某些单元格”，然后才能复制它们。
@SuperSymmetry 嗨 - 如果 lrow 是 A 列中最后一个单元格正下方的行号，那么它永远不会是正确的。 KPI_Month 不是一个空字符串，它是一个日历月。 A1100 是表的末尾。这是我正在修改的同事 VBA。你能建议用什么代替 lrow 吗？

标签： excel vba

【解决方案1】：

我真的希望我能完全理解你的意图，我会假设你这里涉及到两张纸。

Sub test()

    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim foundRange As Range
    Dim lastRow As Long
    
    Set wsSource = ThisWorkbook.Sheets(1) 'or name of the sheet from where info is copied
    Set wsDest = ThisWorkbook.Sheets("Checklist - Audit")
    
    KPI_Month = wsSource.Range("N2").Value
    KPI_QC_Score = wsSource.Range("I10").Value
    KPI_Score_Difference = wsSource.Range("P1").Value
    KPI_QC = wsSource.Range("N11").Value
    KPI_QC_Role = wsSource.Range("N12").Value
    KPI_Date_Stamp = Now()
    
    lastRow = wsDest.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    Set foundRange = wsDest.Range("A1:A1100").Find(What:=KPI_Month, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

        If Not foundRange Is Nothing Then
            wsDest.Cells(lastRow, 5) = KPI_QC_Score
            wsDest.Cells(lastRow, 6) = KPI_Score_Difference
            wsDest.Cells(lastRow, 9) = KPI_QC
            wsDest.Cells(lastRow, 10) = KPI_QC_Role
            wsDest.Cells(lastRow, 11) = KPI_Date_Stamp
        Else
            MsgBox "Reviewer must submit first"
        End If
End Sub

【讨论】：