Особые критерии «Больше 50000» ИЛИ «Менее -50000»

Question

Это то, что я имею до сих пор.Есть пара поправок, которые я хочу сделать, но я не совсем понимаю, как это сделать:

1. В строке 3 я хочу, чтобы мои «Критерии копирования» были «Больше, чем»50000 'или' Менее 50000 '.

2. Как указать ячейки на Листе 2, в которые копируется первый элемент?Например, Sheet2!B10?

3. Как я могу ограничить столбцы, скопированные из строки на листе 1, которая соответствует моим критериям (например) столбцам A, B, E, F, H, I,O & & AG от Sheet1?

    a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(x1Up).Row

    For i = 2 To a

        If Worksheets("Sheet1").Cells(i, 3).Value = **>50000 OR <50000** Then

            Worksheets("Sheet1").Rows(i).Copy
            Worksheets("Sheet2").Activate
            b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(x1Up).Row
            Worksheets("Sheet2").Cells(b + 1, 1).Select
            ActivateSheet.Paste
            Worksheets("Sheet1").Activate

        End if

    Next

    Application.CutCopyMode = False
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select

End Sub

Answer 1

Вы используете x1Up вместо xlUp.

Application.ScreenUpdating = False
Dim cell As Range
With Worksheets("Sheet1")
    For Each cell In .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 2)
        If cell.Value > -50000 Or cell.Value < 50000 Then
            With Worksheets("Sheet2")
                cell.EntireRow.Range("A1:B1,E1:F1,H1,I1,O1,AG1").Copy Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            End With
        End If
    Next
End With

Answer 2

Вы можете использовать функцию Abs() и иметь только одну проверку:

и использовать Range свойство Worksheet объекта для выбора нужных столбцов в данной строке с помощью Intersect() метод:

Option Explicit

Sub main()
    Dim a As Long, i As Long
    Dim sht2 As Worksheet

    Set sht2 = Worksheets("Sheet2") ' set a worksheet object for destination sheet

    With Worksheets("Sheet1") ' reference Sheet1
        a = .Cells(.Rows.Count, 1).End(xlUp).Row ' get referenced sheet column A row index of last not empty cell
        For i = 2 To a
            If Abs(.Cells(i, 3).Value) > 50000 Then ' if cell value in current row index and column 3 is greater than 50000 or less then -500000
                Intersect(.Rows(i), .Range("A:B , E:F, H:I, O:O, AG:AG")).Copy
                sht2.Cells(sht2.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
                Application.CutCopyMode = False
            End If
        Next
    End With
End Sub