Как заставить al oop извлекать значения из другого листа?

Question

Я пытаюсь создать al oop, который извлекает значения из другого листа в рабочей книге.

For i = 3 To 1000

    Worksheets("Cable Estimate").Select

    If Cells(i, 1) = "" Then

        If Equipment = "Station Service Transformer" Then Worksheets("Equipment List").Range("A2:D9").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))

        Exit For

        If Equipment = "13kV PTs (3 phase)" Then Worksheets("Equipment List").Range("A11:D15").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))

        Exit For

        If Equipment = "13kV Tie Breaker" Then Worksheets("Equipment List").Range("A18:D26").Copy Worksheets("Cable Estimate").Range(Cells(i, 1), Cells(i, 4))

        Exit For

     End If

Next i

Переменная «Equipment» установлена ​​равной значению поля со списком, которое представляет собой список материал заполнен с другого листа. Выход для каждого устройства указан в списке, так что команда извлекает данные из другой рабочей таблицы только один раз.

Когда выбран «Станционный сервисный трансформатор» (первое значение в выпадающем списке), код вытягивается правильно в мой лист, однако код не тянет правильно ни одно из следующего оборудования ниже этого. Я полагаю, что что-то упускаю либо до, либо после каждого утверждения «выход для» Я также считаю, что может потребоваться дополнительный код, например «else if», если значение ячейки не пустое, как в первом условии If Cells(i, 1) = "" Then.

Sidenote: формула заработала, создав отдельный for i = 3 to 1000 и помещая «выход для» и «конец, если» для каждой единицы оборудования, но я надеялся, что все это будет работать под одним «я».

Answer 1

Попробуйте, как предложено выше. Обратите внимание также на полную квалификацию всех диапазонов.

Ваши диапазоны копирования и вставки не имеют особого смысла. Копируемые диапазоны имеют длину в несколько строк, поэтому при вставке вы можете перезаписать ячейки.

Наконец, если Equipment не меняет значение, вы можете извлечь его из l oop и сократить код.

With Worksheets("Cable Estimate")
    For i = 3 To 1000
        If .Cells(i, 1) = "" Then
            If Equipment = "Station Service Transformer" Then
                Worksheets("Equipment List").Range("A2:D9").Copy .Range(.Cells(i, 1), .Cells(i, 4))
            ElseIf Equipment = "13kV PTs (3 phase)" Then
                Worksheets("Equipment List").Range("A11:D15").Copy .Range(.Cells(i, 1), .Cells(i, 4))
            ElseIf Equipment = "13kV Tie Breaker" Then
                Worksheets("Equipment List").Range("A18:D26").Copy .Range(.Cells(i, 1), .Cells(i, 4))
            End If
        End If
    Next i
End With

---

Пересмотрено с учетом новых требований

Dim r As Range

With Worksheets("Cable Estimate")
    On Error GoTo 0 'avoid error if there are no blanks
    Set r = .Range(.Cells(3, 1), .Cells(1000, 1)).SpecialCells(xlCellTypeBlanks)(1)
    On Error Resume Next
End With
If Not r Is Nothing Then
    If Equipment = "Station Service Transformer" Then
        Worksheets("Equipment List").Range("A2:D9").Copy r
    ElseIf Equipment = "13kV PTs (3 phase)" Then
        Worksheets("Equipment List").Range("A11:D15").Copy r
    ElseIf Equipment = "13kV Tie Breaker" Then
        Worksheets("Equipment List").Range("A18:D26").Copy r
    End If
End If