VBA - нужно перебрать только видимые клетки

Question

Попытка скопировать определенные ячейки только из отфильтрованных строк, но эта часть кода продолжает копировать все данные даже из скрытых ячеек.

Sheets(Wss).Range("A1").AutoFilter _
     Field:=8, _
      Criteria1:="Vesztesg", _
       VisibleDropDown:=False
 For j = 2 To Sheets(Wss).Range("A2").End(xlDown).End(xlDown).End(xlUp).Row - 1
     Sheets("EBS Posting template").Range("C" & i) = Sheets(Wss).Range("E" & j)
     Sheets("EBS Posting template").Range("O" & i + 1) = Sheets(Wss).Range("F" & j)
     Sheets("EBS Posting template").Range("G" & i + 2) = Sheets(Wss).Range("J" & j)
          i = i + 3
      Next j

Answer 1

Чтобы просмотреть только видимые ячейки, вам нужно пройти через диапазон.Поэтому вместо цикла For i мы используем For Each, что позволит вам сделать это.Мы добавляем .SpecialCells(xlCellTypeVisible) к этому диапазону.

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

Sheets(Wss).Range("A1").AutoFilter _
     Field:=8, _
      Criteria1:="Vesztesg", _
       VisibleDropDown:=False

Dim cl As Range
For Each cl In Range(Cells(2, 1), Cells(Sheets(Wss).Range("A2").End(xlDown).End(xlDown).End(xlUp).Row - 1, 1)).SpecialCells(xlCellTypeVisible) 'Apply visible cells only
     j = cl.Row 'row number of current cl value.
     Sheets("EBS Posting template").Range("C" & i) = Sheets(Wss).Range("E" & j)
     Sheets("EBS Posting template").Range("O" & i + 1) = Sheets(Wss).Range("F" & j)
     Sheets("EBS Posting template").Range("G" & i + 2) = Sheets(Wss).Range("J" & j)
          i = i + 3
Next cl 'loop to next cl

Answer 2

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

Возможно, достаточно просто пройтись по видимым ячейкам.

Кстати: я не уверен, где заканчиваются ваши значения, вам придется изменить это в своем коде.

Код будет перебирать видимые ячейки в столбце E, также проверять имя листа в коде, в этом я тоже не был уверен.

Sub Button2_Click()
    Dim wss As Worksheet, sh As Worksheet, LstRw As Long, rng As Range, c As Range, Lr As Long

    Set wss = Sheets("Sheets(Wss)")
    Set sh = Sheets("EBS Posting template")

    With wss
        LstRw = .Cells(.Rows.Count, 8).End(xlUp).Row
        .Range("A1").AutoFilter Field:=8, Criteria1:="Vesztesg"
        Set rng = .Range("E2:E" & LstRw).SpecialCells(xlCellTypeVisible)

        For Each c In rng.Cells
            With sh
                Lr = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
                .Cells(Lr, "C").Value = c
                .Cells(Lr, "O").Value = c.Offset(, 1)
                .Cells(Lr, "G").Value = c.Offset(, 5)
            End With
        Next c
        .AutoFilterMode = False
    End With

End Sub