Copy/Paste 新工作表中的黄色突出显示单元格 VBA

Question

我正在努力完成这个。

这个宏应该打开一个工作簿（工作簿名称总是会改变，而且总是只有一个 sheet 需要处理）。这行得通。

设置整个范围sheet；工作正常。

然后在整个 sheet 中搜索以黄色突出显示的单元格，然后将这些单元格复制到新的 sheet...这就是我需要帮助的地方！

我是 VBA 的新手，这就是我目前的情况：

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

Answer 1

 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

Copy/Paste 新工作表中的黄色突出显示单元格 VBA

Copy/Paste Yellow Highlighted Cells in a new WorkSheet VBA

excel

vba

copy-paste