在新的WorkSheet VBA中复制/粘贴黄色突出显示的单元格

Sub CopyYellowHighlightedCells()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim cell As Range
    
    ' 设置源工作表和目标工作表
    Set wsSource = ThisWorkbook.Sheets("源工作表")
    Set wsTarget = ThisWorkbook.Sheets("目标工作表")
    
    ' 初始化目标范围的变量
    Dim firstCell As String
    
    ' 遍历源工作表中的所有单元格
    For Each cell In wsSource.UsedRange
        ' 检查单元格的背景颜色是否为黄色
        If cell.Interior.Color = RGB(255, 255, 0) Then
            ' 如果是第一个黄色单元格，则记录位置
            If firstCell = "" Then
                firstCell = cell.Address
            End If
            ' 扩展范围以包含当前黄色单元格
            If rng Is Nothing Then
                Set rng = cell
            Else
                Set rng = Union(rng, cell)
            End If
        End If
    Next cell
    
    ' 如果找到黄色单元格，则执行复制和粘贴操作
    If Not rng Is Nothing Then
        rng.Copy Destination:=wsTarget.Range(firstCell)
    Else
        MsgBox "没有找到黄色突出显示的单元格。", vbInformation
    End If
End Sub