Macro VBA

Option Explicit

Sub Test_pg()
Application.ScreenUpdating = False
Dim NrP As Long, NR1 As Long, Nr2 As Long, x As Long, y As Long, k As Long
Dim FgP As Worksheet, Fg1 As Worksheet, Fg2 As Worksheet
    
Set FgP = Sheets("Risultato")
Set Fg1 = Sheets("Foglio1")
Set Fg2 = Sheets("Foglio2")
    FgP.Activate
        NrP = Range("A" & Rows.Count).End(xlUp).Row
            If NrP < 2 Then NrP = 2
        Range(Cells(2, 1), Cells(NrP, 8)).ClearContents
        Range(Cells(2, 1), Cells(NrP, 8)).Interior.Pattern = xlNone
            k = 2
    Fg1.Activate
        NR1 = Range("A" & Rows.Count).End(xlUp).Row
    Fg2.Activate
        Nr2 = Range("A" & Rows.Count).End(xlUp).Row
    For x = 2 To NR1
        Fg1.Activate
            Fg1.Range(Cells(x, 1), Cells(x, 8)).Copy
        FgP.Activate
            Cells(k, 1).PasteSpecial Paste:=xlValues
            Range(Cells(k, 1), Cells(k, 8)).Interior.Color = 65535
                
        For y = 2 To Nr2
            If Fg2.Cells(y, 1) = Cells(y, 1) Then
                k = k + 1
                    Range(Cells(x, 1), Cells(x, 7)).Copy
                    Cells(k, 1).PasteSpecial Paste:=xlValues
                        Fg2.Cells(y, 7).Copy
                    Cells(k, 8).PasteSpecial Paste:=xlValues
            End If
        Next y
            k = k + 1
    Next x
Set FgP = Nothing
Set Fg1 = Nothing
Set Fg2 = Nothing
Application.ScreenUpdating = True
    Cells(2, 1).Select
End Sub