Macro VBA

Sub CopiaMaria()
Dim i As Long
Dim ur As Long
Dim lr As Long
Dim nVolte As Long
Dim rng As Range
Dim cel As Range
ur = Sheets("Foglio1").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Sheets("Foglio1").Range("A2:A" & ur)
Application.ScreenUpdating = False
For Each cel In rng
    nVolte = Application.WorksheetFunction.CountIf(Sheets("Foglio2").Range("a2:a51"), cel.Value)
    For i = 1 To nVolte + 1
        lr = Sheets("Risultato").Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("Foglio1").Activate
        Range(Cells(cel.Row, "A"), Cells(cel.Row, "H")).Copy Destination:=Sheets("Risultato").Cells(lr + 1, "A")
    Next i
Next cel
Sheets("prova").Activate
Application.ScreenUpdating = True
End Sub

Sub duplicaRighe()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Set Sh1 = Worksheets("Foglio1")
Set Sh2 = Worksheets("Foglio2")
Set Sh3 = Worksheets("Risultato")
Ur1 = Sh1.Range("A" & Rows.Count).End(xlUp).Row
ur2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row
Sh3.Range("A2:H" & Rows.Count).ClearContents
r1 = 2
r2 = 2
r3 = 2
For j1 = r1 To Ur1
    codice = Sh1.Cells(j1, 1)
    Sh1.Range("A" & j1 & ":H" & j1).Copy Sh3.Range("A" & r3)
    r3 = r3 + 1
    For j2 = r2 To ur2
        If Sh2.Cells(j2, 1) = codice Then
            Sh1.Range("A" & j1 & ":G" & j1).Copy Sh3.Range("A" & r3)
            Sh3.Cells(r3, 8) = Sh2.Cells(j2, 7)
            r3 = r3 + 1
        End If
    Next j2
Next j1
End Sub

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

 If Fg2.Cells(y, 1) = Cells(y, 1) Then 

 If Fg2.Cells(y, 1) = Cells(x, 1) Then