Я пытаюсь сделать это.

Этот макрос должен открывать книгу (имена книг всегда меняются, и всегда остается только один лист для обработки). Это работает.

Установите диапазон для всего листа; работает отлично.

И найдите на всем листе ячейки, выделенные желтым цветом, и скопируйте эти ячейки на новый лист ... и здесь мне нужна помощь!

Я действительно новичок в 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
0
battleboy 6 Мар 2019 в 18:34

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
0
marc_s 21 Май 2019 в 21:00