Как скопировать строки на основе двух критериев столбца и вставить данные c в VBA?

Question

У меня 4 столбца (A, B, C, D, E) в исходном листе. Я хочу, чтобы в цель были скопированы только строки для первых двух столбцов (A, B). Эти два столбца копируются на основе значения в столбцах (D, E) «Да». Кроме того, я хотел бы скопировать на целевой лист в столбцах (C, D) заголовки столбцов (D, E) из исходного листа. Для Instan c, вот содержимое исходного листа

  A  |  B |  C  |  D |  E  |
testX| 123| xyz | No | Yes |
testY| 125| xyz | Yes| No  |

То, что я хотел бы скопировать на целевой лист, выглядит следующим образом:

  A  |  B |  C |
testX| 123|  E | 
testY| 125|  D |

E и D - заголовки из целевого листа. Кроме того, если вы заметили, меня не интересует столбец C из исходного листа, и мне не нужно его копировать в целевой лист

Мой код правильно считывает критерий «да», но он копирует целые строки и ничего не делает для копирования заголовков. Так что я получаю точную копию исходного листа. Например,

  A  |  B |  C  |  D |  E  |
testX| 123| xyz | No | Yes |
testY| 125| xyz | Yes| No  |

Мне нужна помощь, чтобы завершить этот проект. Спасибо

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")

    j = 4     ' Start copying to row 4 in target sheet
    For Each c In Source.Range("D5:E1000")   
        If c = "Yes" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c
End Sub

Answer 1

Попробуйте следующее:

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")

    j = 4     ' Start copying to row 4 in target sheet
    For Each c In Source.Range("D5:E1000").Cells   
        If c = "Yes" Then
           c.EntireRow.Cells(1).Resize(1, 2).copy Target.Cells(j, 1)  'ColA, B
           Target.Cells(j ,3).Value = Source.Cells(4, c.Column).Value 'Header
           j = j + 1
        End If
    Next c
End Sub