Confronta più colonne in due fogli per ottenere un valore

Ho una conoscenza limitata delle macro VBA di Excel. Ho due fogli chiamati "Riepilogo" e "Dati"

• Il foglio di riepilogo ha riparato righe e colonne.
• La scheda tecnica contiene dei valori.

Devo confrontare il codice, il numero MRC dell'azienda e lo stato dei fogli di riepilogo e dati e se i campi corrispondono, ottenere il valore corrispondente dal foglio dati al campo Riepilogo.

La mia soluzione è basata su schermata allegata , dove ho trovato solo due colonne comuni tra i fogli , siamo

1. Codice

2. Società MRC

Non riesco a trovare Status Of Summary & amp; Campo dati.

Vorrei suggerire un set di macro per confrontare entrambi i fogli per i dati comuni da copiare in un altro foglio.

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

Come funziona:

1. Rispondere ad entrambi Scatole di input con un intervallo dati appropriato da entrambi i fogli da confrontare.
2. La volontà di macro evidenziare Dati duplicati nel Foglio 1 (Scheda dati) con colore rosso .
3. CORRERE la sottostante scritta Macro per copiare i dati duplicati.
4. Copia entrambe le macro come Modulo standard .

Modificato:

Effettuare le seguenti operazioni per evitare l'uso della seconda macro:

1. Seleziona l'intervallo di dati in DATA Sheet & Amp; applicare Filtro automatico .
2. Filtro Righe in Colore rosso .
3. copia Righe filtrate.

4. Posiziona il puntatore della cella sulla cella richiesta & amp; applicare Paste speciali quindi fare clic Valore .

   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 & Amp; lNewRow i valori sono modificabili.