I have tried to adapt this macro from working on an adjacent array to working on a single column. The original macro put the data in a new sheet but I want it in column j
There are no bugs but it is not working even to paste in another sheet. Can someone help please.
There are no bugs but it is not working even to paste in another sheet. Can someone help please.
VBA Code:
Public Sub Getcolourcont() 'searches for coloured cells and collects the cell address,
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For r = 2 To FinalRow
For C = 1 To 1
ThisValue = Cells(r, C).Interior.Color
FirstCell = Cells(r, C).Address
If ThisValue = RGB(0, 255, 255) Then ' Decide if to copy based on contents of the row
Cells(r, 1).Resize(1, 6).Copy ' Copy the cells 1 to 6 to the clipboard
Sheets("Sheet2").Select
NextRow = Cells(Rows.Count, 2).End(xlUp).Row + 1 'specify cell to paste at destination
Cells(NextRow, 1).Value = FirstCell 'paste the cell address
Cells(NextRow, 2).Select
ActiveSheet.Paste
Sheets("Sheet5").Select
End If
Next C
Next r
End Sub
Beam2 2022.xlsm | |||||||||
---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | |||
27 | 73.43705 | 44853.5 | 11.4 | 1 | 0 | 0 | 0 | ||
28 | 73.43762 | 44853.5 | 11.4 | 1 | 0 | 0 | 0 | ||
29 | 73.43653 | 44853.5 | 11.4 | 1 | 0 | 0 | 0 | ||
30 | 73.53633 | 44853.5 | 11.4 | 1 | 0 | 0 | 0 | ||
31 | 73.43596 | 44853.5 | 11.4 | 1 | 0 | 0 | 0 | ||
32 | 73.43612 | 44853.5 | 11.4 | 1 | 0 | 0 | 0 | ||
33 | 73.43681 | 44853.5 | 11.6 | 1 | 0 | 0 | 0 | ||
34 | 73.43787 | 44853.5 | 11.5 | 1 | 0 | 0 | 0 | ||
Sheet5 |