I'm trying to get this one done.
This macro should open a workbook (workbook names always change and there's always just one sheet to process). This works.
Set the range for the whole sheet; works fine.
And search the entire sheet for cells highlighted in yellow, and copy these cells into a new sheet... and this is where I need help!
I am really new to VBA and thats what I have so far:
Option Explicit
Sub test3()
Dim data As Variant
Dim rngTemp As Range
Dim cell As Range
'//open Workbook
data = Application.GetOpenFilename(, , "Open Workbook")
Workbooks.Open data
'// set Range ( Whole Sheet)
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not rngTemp Is Nothing Then
Range(Cells(1, 1), rngTemp).Select
End If
'// Search for Yellow highlighted Cells and (if you find one)
'// Copy Cell B1 + the 3rd Cell in the column (of the highlighted Cell) + the value highlighted Cell
'// and paste in new Sheet
For Each cell In rngTemp.Cells
If rngTemp.Interior.ColorIndex = 6 Then
cell.Select
Selection.Copy
Sheets.Add
Range("A1").PasteSpecial
Application.CutCopyMode = False
End If
Next
End Sub
Sub test3()
Dim wbName As string
Dim rngTemp As Range
Dim r As Range
DIM TARGETSHEET AS WORKSHEET
DIM TARGET AS RANGE
'//open Workbook
wbName = Application.GetOpenFilename(, , "Open Workbook")
if wbName = "" or wbname = "CANCEL" then exit sub
Workbooks.Open wbname
'// set Range ( Whole Sheet)
Set rngTemp = Activesheet.usedrange
SET TARGETSHEET = ACTIVEWORKBOOK.WORKSHEETS.ADD()
SET TARGET = TARGETSHEET.RANGE("A1")
'// Search for Yellow highlighted Cells and (if you find one)
'// Copy Cell B1 + the 3rd Cell in the Column (of the highlighted Cell) + the value highlighted Cell
'// and paste in new Sheet
For Each r In rngTemp
If r.Interior.ColorIndex = 6 Then
TARGET = rngtemp.parent.range("B1")
TARGET.OFFSET(0,1) = r
TARGET.OFFSTE(0,2) = rngtemp.parent.cells(3,r.column)
'I've assumed you want them across the first row
SET TARGET = TARGET.OFFSET(1,0)
End If
Next r
End Sub