Как перебрать отдельные ячейки массива

Question

Унаследовал макрос, на котором я не на 100%, и мне нужно его исправить.По сути, он должен проверить, заполнена ли каждая из ссылочных ячеек, если true - скопировать в ячейку плана, если isEmpty, ничего не делать.Однако, кажется, что он копирует независимо.

Попытка добавления для каждого цикла, но, похоже, не действует.

refGap = findRefGap(refCol, LR, valToCopy)
planGap = findPlanGap(refCol, LR)



For i = 23 To LR
    'Checks to see if the cell is actually referencing a product.
    If IsEmpty(Cells(i, prodCol).value) = False And Cells(i, prodCol).value <> "Result" Then
'        RefPt is the row where ref demand is found, same with planPt to planned non-promoted volume.
        refPt = i + refGap
        planPt = i + planGap

        Range(Cells(refPt, calCol), Cells(refPt, LC)).copy
        Range(Cells(planPt, calCol), Cells(planPt, LC)).PasteSpecial xlPasteValues

    End If
Next

Answer 1

Что-то вроде этого возможно?

Sub tgr()

    Dim ws As Worksheet
    Dim rPlan As Range
    Dim rReference As Range
    Dim sHeadersCol As String
    Dim sFirst As String
    Dim lCol As Long

    Set ws = ActiveWorkbook.ActiveSheet
    sHeadersCol = "A"

    Set rPlan = ws.Columns(sHeadersCol).Find("Plan", ws.Cells(ws.Rows.Count, sHeadersCol), xlValues, xlWhole)
    If Not rPlan Is Nothing Then
        sFirst = rPlan.Address
        Do
            Set rReference = ws.Range(rPlan, rPlan.End(xlDown)).Find("Reference", rPlan, xlValues, xlWhole)
            If Not rReference Is Nothing Then
                For lCol = rPlan.Column + 1 To rPlan.Column + rPlan.CurrentRegion.Columns.Count - 1
                    If Len(Trim(ws.Cells(rReference.Row, lCol).Value)) > 0 Then ws.Cells(rPlan.Row, lCol).Value = ws.Cells(rReference.Row, lCol).Value
                Next lCol
            End If
            Set rPlan = ws.Columns(sHeadersCol).Find("Plan", rPlan, xlValues, xlWhole)
        Loop Until rPlan.Address = sFirst
    End If

End Sub