Функция копирования и вставки VBA, где выполняются два критерия

Question

Я новичок в кодировании VBA и не могу понять, как я могу копировать и вставлять значения из одного листа в другой, если будут выполнены два критерия. На листе ниже я хочу скопировать «12, 9 и 15» и вставить его в ячейки «Ожидается, P10 и P90» на листе 2, если имена на листе один «Оранжевый, зеленый» совпадают с именами на листе 1.

Я уже давно пытаюсь сделать это самостоятельно удачи.

Прикрепленный код, который я начал

Sub Copy_Certain_Data()

    a = Worksheets("Schedule Results").Cells(Rows.Count, 1).End(xlUp).Row


    For i = 3 To a

    If Worksheets("Schedule Results").Cells(i, 3).Value = "NE2P1" Then

    Worksheets("schedule results").Rows(i).Copy

    Worksheets("Campaign 1 Data").Activate

    Range("F2").Select

    ActiveSheet.Paste

    Worksheets("Schedule Results").Activate

    End If
    Next

    Application.CutCopyMode = False

End Sub

Answer 1

Ниже приведен базовый макрос c для l oop через две таблицы и найдите строку, имеющую совпадающие значения в столбцах A и B. Затем запишите значения из строки на листе 1, столбцы C: E строка в листе 2, столбцы D: F.

Dim ws1 As Worksheet, ws2 As Worksheet
Dim xCel As Range, yCel As Range

Set ws1 = ThisWorkbook.Sheets("Sheet1") 'change sheet names as needed
Set ws2 = ThisWorkbook.Sheets("Sheet2")

    For Each xCel In ws1.Range("A2", ws1.Range("A" & ws1.Rows.Count).End(xlUp)) 'loop sheet1 column A

        If xCel.Value = "Orange" And xCel.Offset(, 1).Value = "Green" Then 'when both values are found in row goto sheet2 loop

            For Each yCel In ws2.Range("A2", ws2.Range("A" & ws2.Rows.Count).End(xlUp)) 'Loop sheet2 Column A

                If yCel.Value = "Orange" And yCel.Offset(, 1).Value = "Green" Then 'when found write values from sheet1 to sheet2
                    yCel.Offset(, 3).Resize(, 3).Value = xCel.Offset(, 2).Resize(, 3).Value
                End If

            Next yCel
        End If
    Next xCel

Answer 2

Это должно дать вам начало, чтобы получить то, что вы пытаетесь достичь на основе кода, который вы пробовали. Всегда рекомендуется устанавливать переменные, а также квалифицировать рабочие таблицы.

Использование .copy и .paste может вызвать проблемы, потому что, если ячейки не одинакового размера, вы получите сообщение об ошибке, и именно поэтому Я всегда устанавливаю значение ячейки назначения = значение ячейки источника.

Option Explict
Sub Copy_Certain_Data()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet

    Set wb = ThisWorkbook
    Set wsSource = wb.Sheets("Schedule Results")
    Set wsDest = wb.Sheets("Campaign 1 Data")

    Dim LastRow As Long, i As Long

    LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    For i = 3 To LastRow
            If wsSource.Cells(i, 3).Value = "NE2P1" Then
                wsDest.Cells(i, 6) = wsSource.Cells(i, 3)
            End If
    Next i

End Sub