Попытка Скопировать столбец и вставить в другой лист на основе значения другой ячейки VBA

Question

Я пытаюсь скопировать содержимое столбца, только если другая ячейка равна «Да». Если ячейка равна «Да», я хочу вставить выбранный диапазон столбцов в другую книгу. Затем l oop до следующего "Да".

    If M2 = "Yes" then copy AD2:AD200 if "NO" go to the next "if"
    If M3 = "Yes" then copy AE2:AE200 if "NO" go to the next "if"
    If M4 = "Yes" then copy AF2:AF200 if "NO" go to the next "if" 

и так далее ...

Последнее, что я буду искать, это M11.

Затем вставьте диапазон копий в последнюю пустую ячейку на листе «Случаи в статусе контроля качества»,

    range("AL200",range("al200").end(xlUp).select

Это то, что у меня есть:

    Sheets("Sheet1").Select
    If Range("M8").Value = True Then
    Range("aj2:aj200").Select
    Selection.Copy
    Sheets("Cases in QA Status").Select
    End If
    End Sub

Answer 1

1. Метод копирования

Sub test()
    Dim Ws As Worksheet, toWs As Worksheet
    Dim vDB As Variant, rngDB As Range
    Dim Target As Range
    Dim i As Long

    Set Ws = Sheets("Sheet1")
    Set toWs = Sheets("Cases in QA Status")
    With Ws
        vDB = .Range("m2", .Range("m" & Rows.Count).End(xlUp))
    End With

    For i = 1 To UBound(vDB, 1)
        If vDB(i, 1) = "Yes" Then 'vDB(i, 1) = True then
            Set rngDB = Ws.Range("ad2").Resize(199).Offset(, i - 1)
            Set Target = toWs.Range("al" & Rows.Count).End(xlUp).Offset(1, 0)
            rngDB.Copy Target
        End If
    Next i
End Sub

2. Использование массива

Sub test2()
    Dim Ws As Worksheet, toWs As Worksheet
    Dim vDB As Variant, vData As Variant
    Dim Target As Range
    Dim i As Long

    Set Ws = Sheets("Sheet1")
    Set toWs = Sheets("Cases in QA Status")
    With Ws
        vDB = .Range("m2", .Range("m" & Rows.Count).End(xlUp))
    End With

    For i = 1 To UBound(vDB, 1)
        If vDB(i, 1) = "Yes" Then 'vDB(i, 1) = True then
            vData = Ws.Range("ad2").Resize(199).Offset(, i - 1)
            Set Target = toWs.Range("al" & Rows.Count).End(xlUp).Offset(1, 0)
            Target.Resize(199) = vData
        End If
    Next i
End Sub

Answer 2

Можете ли вы попробовать следующее?

If Sheets("Sheet1").Range("M8").Value = True Then
    Sheets("Sheet1").Range("aj2:aj200").Copy
    ActiveSheet.Paste Destination:=Sheets("Cases in QA Status").Range("A1")
End If

И повторить для других столбцов:).

Естественно, если в столбце есть "Да", то замените True на "Yes".