突出显示的单元格而非特定单元格的宏

时间:2018-05-23 14:45:09

标签: excel vba excel-vba

我正在编写一个excel宏,它将获取在一个excel工作簿中突出显示的信息并将其粘贴到新工作簿中。

我目前使用的代码从特定单元格获取信息,但我需要它是整个电子表格中突出显示的某些单元格。

我目前的代码是

Sub copy()

Workbooks("Book2.xlsx").Worksheets("Master Data").Range("A8:I14").copy _
Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1")


End Sub

修改

通过突出显示,我并不是指用颜色或格式突出显示。我的意思是通过单击并拖动选择多个单元格来选择单元格

1 个答案:

答案 0 :(得分:2)

Option Explicit

Sub CopySpecificRange()

    Dim srcRange As Range
    Set srcRange = Worksheets(1).Range("A8:I14")

    Dim myCell  As Range
    Dim srcRangeColored As Range

    For Each myCell In srcRange
        If myCell.Interior.Color = vbYellow Then
            If Not srcRangeColored Is Nothing Then
                Set srcRangeColored = Union(srcRangeColored, myCell)
            Else
                Set srcRangeColored = myCell
            End If
        End If
    Next myCell

    If Not srcRangeColored Is Nothing Then
        srcRangeColored.copy Worksheets(2).Range("A2")
    End If

End Sub

关于你只想要在vbYellow中着色的单元格,上面的代码可以工作。只需确保根据需要正确修正了Worksheets(2)Worksheets(1)

根据您的需要,可能最好将彩色值保存在数据结构(数组或列表)中,并将其放在范围A2中。因此,请考虑您只对A1:D10范围内的黄色单元格感兴趣:

enter image description here

因此,试图得到这个:

enter image description here

您可以将myColl用作Collection并向其添加任何vbYellow单元格。然后,使用递增的cnt,可以很容易地将集合的值放在一行上:

Sub CopySpecificRange()

    Dim srcRange As Range
    Set srcRange = Worksheets(1).Range("A1:D10")

    Dim myCell  As Range
    Dim srcRangeColored As Range
    Dim myColl As New Collection

    For Each myCell In srcRange
        If myCell.Interior.Color = vbYellow Then
            myColl.Add myCell.Value2
        End If
    Next myCell

    Dim cnt As Long: cnt = 1
    With Worksheets(2)
        For Each myCell In .Range(.Cells(1, 1), .Cells(1, myColl.Count))
            myCell = myColl.Item(cnt)
            cnt = cnt + 1
        Next myCell
    End With

End Sub

关于编辑,突出显示意味着选择。

输入:

enter image description here

输出:

enter image description here

Sub CopySelectedRanges()

    Dim myCell  As Range
    Dim srcRangeColored As Range
    Dim myColl As New Collection

    For Each myCell In Selection.Cells
        myColl.Add myCell.Value2
    Next myCell

    Dim cnt As Long: cnt = 1
    With Worksheets(2)
        For Each myCell In .Range(.Cells(1, 1), .Cells(1, myColl.Count))
            myCell = myColl.Item(cnt)
            cnt = cnt + 1
        Next myCell
    End With

End Sub