时间戳

首页 > 解决方案 > 复制没有填充条件格式列的单元格

excel - 复制没有填充条件格式列的单元格

问题描述

我正在尝试创建一个 VBA 宏，用于搜索条件格式列中的填充单元格，并仅选择包含数据但未被条件格式填充为红色的单元格（无填充颜色）。

然后，一旦选择了没有填充的单元格，我想将它们复制到不同列的底部。我被困在我范围内选择未填充的单元格。

    Sub PM2_COPY()

    Sheets("M&C").Select
    range("A2").Select
    range(selection, selection.End(xlDown)).Select
    selection.COPY
    Sheets("SUMMARY").Select
    range("U7").Select
    selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    range("U6").Select
    Application.CutCopyMode = False
    selection.AutoFilter
    ActiveWorkbook.Worksheets("SUMMARY").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SUMMARY").AutoFilter.Sort.SortFields.Add(range( _
        "U6"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
        = RGB(255, 199, 206)
    With ActiveWorkbook.Worksheets("SUMMARY").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    range("U7").Select
    range.AutoFilter (cell.Interior.ColorIndex = xlNone)
    For Each cell In range.AutoFilter(cell.Interior.ColorIndex = xlNone)
    cell.Select
    selection.COPY
    Sheets("SUMMARY").Select
    range("A7").End(xlDown).Offset(1, 0).Select
    selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    End If
    Next
End Sub

标签： excelvbaconditional-formatting

解决方案

使用Range.AutoFilter并指定没有颜色的单元格，然后复制可见单元格。类似于以下内容：

With ActiveWorkbook.Worksheets("SUMMARY")
    Dim lastRow As Long
    lastRow = .Cells(.Rows.Count, "U").End(xlUp).Row

    .Range("U6:U" & lastRow).AutoFilter Field:=1, Operator:= _
        xlFilterNoFill

    On Error Resume Next
    Dim visibleCells As Range
    Set visibleCells = .Range("U7:U" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    .ShowAllData ' Clear filter

    If Not visibleCells Is Nothing Then
        visibleCells.Copy
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues

        Application.CutCopyMode = False
    End If
End With

推荐阅读