Carl O' Beirne
Carl O' Beirne

Reputation: 71

Macro for highlighted cells rather than specific cells

I am writing an excel macro that will grab information that is highlighted in one excel workbook and paste it into a new workbook.

The code I currently have takes the info from specific cells, but I need it to be of certain cells that are highlighted throughout the spreadsheet.

The code I currently have is

Sub copy()

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


End Sub

EDIT

By highlighted, I do not mean highlighted with a colour or with formatting. I mean by selecting a multitude of cells by click and dragging to select cells

Upvotes: 1

Views: 1929

Answers (1)

Vityata
Vityata

Reputation: 43585

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

Concerning that you want only cells, colored in vbYellow the code above works. Just make sure that you fix correctly the Worksheets(2) and Worksheets(1) as you wish.

Depending on what you want, probably it is a better idea to save the colored values in a data structure (array or list), and to put it one after another in range A2. Thus, consider that you are interested in the yellow cells of A1:D10 range only:

enter image description here

Thus, trying to get this:

enter image description here

You may use the myColl as a Collection and add any vbYellow cell to it. Then, using the incremented cnt, it is easy to put the values of the collection on a single row:

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

And concerning the edit, where highlighted means selected.

Input:

enter image description here

Output:

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

Upvotes: 2

Related Questions