求助：Excel宏实现按G列值查找最后匹配行并复制后续数据

需求概述 #

• 宏功能：点击按钮更新工作表，数据从无宏工作簿导入至「Do Not Delete」工作表
• 已完成部分：将「Do Not Delete」数据以值的形式复制到「CopyAndClear」工作表，并删除包含#VALUE!的行
• 待实现功能：遍历「Do Not Delete」的每一行，查找该行G列值在工作簿其他工作表中的最后匹配行，复制该行及之后的所有数据

现有宏代码 #

Sub CopyToSheet()
'
' CopyToSheet Macro

Dim wb As Workbook
Dim ws, wscopy, wsdnd As Worksheet
Dim i, LastRowa, LastRowd As Long
Dim WSheet As String
Dim SheetName As String

Set wsdnd = Sheets("Do Not Delete")
Set wscopy = Sheets("CopyAndClear")
Set wb = ActiveWorkbook
Set ws = ActiveWorkbook.Sheets("Macro - Do not delete")

'Finding Sheet to use
SheetName = Range("L2")
Debug.Print Range("L2")

'Clear Contents
wscopy.Activate
wscopy.Cells.Clear

'Activating Do Not Delete Sheet to copy the data
wsdnd.Activate
LastRowa = wsdnd.Cells(Rows.Count, "A").End(xlUp).Row
wsdnd.Range("A1:IP" & LastRowa).Select
wsdnd.Range("A1:IP" & LastRowa).Copy

'Copy and paste cells onto new sheet
wscopy.Activate
wscopy.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
        
'Apply Filter
Application.DisplayAlerts = False
LastRowc = wscopy.Cells(Rows.Count, "A").End(xlUp).Row
wscopy.Range("A1:IP" & LastRowc).AutoFilter Field:=1, Criteria1:="#VALUE!"


'Delete Rows
wscopy.Range("A1:IP" & LastRowc).SpecialCells(xlCellTypeVisible).Delete

'Clear Filter
On Error Resume Next
wscopy.ShowAllData
On Error GoTo 0

End Sub

解决方案说明 #

1. 修正变量声明问题：原代码中Dim ws, wscopy, wsdnd As Worksheet仅wsdnd被声明为Worksheet类型，其余为Variant，需逐个明确类型
2. 避免Activate/Select操作：直接通过对象引用操作工作表和单元格，提升宏的运行效率与稳定性
3. 实现最后匹配行查找：使用Range.Find方法，设置SearchDirection:=xlPrevious找到G列值在目标工作表中的最后匹配行
4. 复制匹配行及后续数据：找到匹配行后，复制该行至工作表末尾的所有数据到目标位置

修改后的完整代码 #

Sub CopyToSheet()
'
' CopyToSheet Macro

Dim wb As Workbook
Dim ws As Worksheet, wscopy As Worksheet, wsdnd As Worksheet
Dim i As Long, LastRowa As Long, LastRowc As Long, LastMatchRow As Long
Dim SheetName As String
Dim searchValue As Variant
Dim matchRange As Range

Set wb = ActiveWorkbook
Set wsdnd = wb.Sheets("Do Not Delete")
Set wscopy = wb.Sheets("CopyAndClear")
Set ws = wb.Sheets("Macro - Do not delete")

' 获取目标工作表名称（从指定单元格读取）
SheetName = ws.Range("L2").Value
Debug.Print SheetName

' 清空CopyAndClear工作表内容
wscopy.Cells.Clear

' 复制Do Not Delete的数据到CopyAndClear（仅值）
LastRowa = wsdnd.Cells(Rows.Count, "A").End(xlUp).Row
wsdnd.Range("A1:IP" & LastRowa).Copy
wscopy.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
        
' 过滤并删除含#VALUE!的行
Application.DisplayAlerts = False
LastRowc = wscopy.Cells(Rows.Count, "A").End(xlUp).Row
wscopy.Range("A1:IP" & LastRowc).AutoFilter Field:=1, Criteria1:="#VALUE!"
On Error Resume Next
wscopy.Range("A2:IP" & LastRowc).SpecialCells(xlCellTypeVisible).Delete ' 保留表头
On Error GoTo 0
wscopy.ShowAllData
Application.DisplayAlerts = True

' 遍历Do Not Delete的每一行，查找G列值在目标工作表的最后匹配行并复制后续数据
LastRowa = wsdnd.Cells(Rows.Count, "G").End(xlUp).Row
For i = 2 To LastRowa ' 假设第1行是表头，从第2行开始遍历
    searchValue = wsdnd.Cells(i, "G").Value
    If Not IsError(searchValue) And searchValue <> "" Then ' 跳过错误值和空值
        ' 在目标工作表中查找最后匹配的行
        Set matchRange = wb.Sheets(SheetName).Columns("G").Find( _
            What:=searchValue, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False)
        
        If Not matchRange Is Nothing Then
            LastMatchRow = matchRange.Row
            ' 复制匹配行至目标工作表末尾的数据到CopyAndClear的空白区域
            Dim targetLastRow As Long
            targetLastRow = wscopy.Cells(Rows.Count, "A").End(xlUp).Row + 1
            wb.Sheets(SheetName).Range("A" & LastMatchRow & ":IP" & wb.Sheets(SheetName).Cells(Rows.Count, "A").End(xlUp).Row).Copy
            wscopy.Range("A" & targetLastRow).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    End If
Next i

End Sub

代码关键点解释 #

• 变量类型修正：所有工作表变量明确声明为Worksheet，数值变量声明为Long
• 查找逻辑：Find方法的SearchDirection:=xlPrevious确保找到最后一个匹配项
• 错误处理：跳过G列的错误值和空值，避免查找出错；删除行时保留表头，防止误删
• 高效操作：全程避免Activate和Select，直接通过对象引用操作，提升运行速度

内容的提问来源于stack exchange，提问作者AB4444