Найдите диапазон между двумя словами и переберите его с помощью цикла

Question

Я создал метод для определения диапазона между двумя словами и перебора его, чтобы скопировать значения вставки с одного рабочего листа на другой. По какой-то странной причине он не работает.

1. Я указываю строку, это 18, мой код начинается с строки 20? Таким образом, он копирует все, начиная с строки 20. O_o
2. Он неправильно определяет диапазон, поскольку он также копирует значения под моими словами? Я проверил, что у меня нет таких слов в другом месте.

Есть предложения?

Вот код для вызова метода:

Sub dsfdsfdsfds()
    copyOptionsToTable 18, CalculationItemOM1
End Sub

Вот метод :

Private Sub copyOptionsToTable(RowToPaste As Integer, OperatingWorksheet As Worksheet)

    'Dim FirstWord, SecondWord
    Dim OptionsRange As Range
    Dim cell, x
            
    'Set FirstWord = OperatingWorksheet.Range("W:W").Find("OPTIOONS START", LookIn:=xlValues, lookat:=xlWhole)
    'Set SecondWord = OperatingWorksheet.Range("W:W").Find("OPTIOONS END", LookIn:=xlValues, lookat:=xlWhole)
    Set OptionsRange = OperatingWorksheet.Range(OperatingWorksheet.Cells.Find("[OPTIOONS START]"), OperatingWorksheet.Cells.Find("[OPTIOONS END]"))
    
    x = 0
    
    ' Copy - Paste process
    For Each cell In OptionsRange
        If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then
            ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste).Offset(0 + x, 0).Value = cell.Offset(0 + x, -20).Value
            ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste).Offset(0 + x, 3).Value = cell.Offset(0 + x, 2).Value
        End If
        
        x = x + 1
    Next cell

End Sub

Исходный лист:

Output sheet:

---

EDIT:

Output still looks like this?

введите описание изображения здесь

Answer 1

Вы уже увеличиваете cell на одну строку внутри l oop - вам не нужно дополнительно смещать это, используя x

Set OptionsRange = OperatingWorksheet.Range( _
        OperatingWorksheet.Cells.Find("[OPTIOONS START]").Offset(1,0), _ 
        OperatingWorksheet.Cells.Find("[OPTIOONS END]").Offset(-1, 0))
    
x = 0

' Copy - Paste process
For Each cell In OptionsRange.Cells
    If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then
        With ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste)
            .Offset(x, 0).Value = cell.Offset(0, -20).Value
            .Offset(x, 3).Value = cell.Offset(0, 2).Value
        End With
        x = x + 1 '<< only increment if you copied values...
    End If
Next cell

Также я не уверен, что это линия делает то, что вы намереваетесь?

If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then

возможно

If Not IsEmpty(cell.Value) And cell.Value <> "OPT" Then