Sub CopyTrueRowsToSheet2()
Dim wsSource As Worksheet: Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Dim wsTarget As Worksheet: Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
' 找到最后一行
lRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
For i = 1 To lRow
If UCase(Trim(wsSource.Range("A" & i).Value)) = "TRUE" Then
rowToCopy = i
Exit For
End If
Next
' 如果找到符合条件的行,则执行复制和粘贴操作
If rowToCopy > 0 Then
wsSource.Rows(rowToCopy).Copy
wsTarget.Rows(2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
MsgBox "已将 Sheet1 中第 " & rowToCopy & " 行复制并粘贴到 Sheet2。", vbInformation, "提示"
Else
MsgBox "未找到要复制的行。", vbCritical, "错误"
End If
End Sub