Reputation: 71
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
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:
Thus, trying to get this:
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:
Output:
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