Compara columnas múltiples en dos hojas para obtener un valor

Tengo un conocimiento limitado de las macros de Excel VBA. Tengo dos hojas llamadas "Resumen" y "Datos"

• La hoja de resumen tiene filas y columnas fijas.
• La hoja de datos tiene valores en ella.

Necesito comparar el Código, el número de MRC de la Compañía y el Estado de las hojas de Resumen y Datos y, si los campos coinciden, obtenga el valor correspondiente de la Hoja de datos al campo Resumen.

Mi solución se basa en el captura de pantalla adjunta donde encontré solo dos columnas comunes entre hojas , son

1. Código

2. Empresa MRC

No puedo encontrar el estado del resumen & amp; Campo de datos.

Me gustaría sugerir un conjunto de macros para comparar ambas hojas para que los datos comunes se copien en otra hoja.

Sub CompareRanges()

Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range

Set WorkRng1 = Application.InputBox("Range A:", "", Type:=8)
Set WorkRng2 = Application.InputBox("Range B:", Type:=8)

For Each Rng1 In WorkRng1
rng1Value = Rng1.Value

For Each Rng2 In WorkRng2

If rng1Value = Rng2.Value Then
Rng1.Interior.Color = VBA.RGB(255, 0, 0)
Exit For

End If
Next
Next

End Sub

Cómo funciona:

1. Responder a las dos Cajas de entrada con un rango de datos apropiado de ambas hojas para ser comparado.
2. Macro resaltar datos duplicados en la Hoja 1 (Hoja de datos) con color rojo .
3. CORRER la siguiente macro escrita para copiar datos duplicados.
4. Copia ambas macros como Módulo estándar .

Editado:

Haga lo siguiente para evitar el uso de la segunda macro:

1. Seleccione el rango de datos en DATA Sheet &erio; aplicar Filtro automático .
2. Filtrar Filas en Color rojo .
3. Dupdo Filas filtradas

4. Coloque el puntero de la celda en la celda requerida & amp; aplicar Pastas Especiales luego haga clic Valor .

   Sub CopyRedRows()
   
   Dim wks As Worksheet
   Dim wNew As Worksheet
   Dim lRow As Long
   Dim lNewRow As Long
   Dim x As Long
   
   Set wks = Sheets("Data")
   lRow =  wks.Cells.SpecialCells(xlCellTypeLastCell).Row 
   
     Set wNew = Sheets("Summary")
     lNewRow = 10
   
     For x = 1 To lRow
       If wks.Cells(x, 1).Interior.Color = vbRed Then
         wks.Cells(x, 1).EntireRow.Copy wNew.Cells(lNewRow, 1)
         lNewRow = lNewRow + 1
       End If
     Next
   
   End Sub
   

5. Sheet Name, RGB Color Code &erio; lNewRow Los valores son editables.