Public Sub copiabis()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim wk As Workbook
    Dim wk1 As Workbook
    Dim r As Long

    With Application
        .ScreenUpdating = False
    End With
    sPath = ThisWorkbook.Path    ' & "
uova cartella"    '<< da Modificare
    Set wk1 = Workbooks("DESTINAZIONE.xlsx")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)

    For Each objFile In objFolder.Files
        myname = Dir(objFile, vbNormal)
        If Left(myname, 1) <> "~" And (Right(myname, Len(myname) - InStrRev(myname, ".")) Like "*xl*") And (myname <> ThisWorkbook.Name) Then

            Set wk = Workbooks.Open(objFile.Path)
            irow = wk.Sheets("foglio1").Range("b" & Rows.Count).End(xlUp).Row
            irow1 = wk1.Sheets("foglio1").Range("b" & Rows.Count).End(xlUp).Row
            Set Rng = wk.Sheets("foglio1").Range("b2:b" & irow)
            Set rng1 = wk1.Sheets("foglio1").Range("b2:b" & irow1)
            For Each cl In Rng
                For Each lc In rng1
                    If cl Like lc And cl.Offset(0, 1) <> lc.Offset(0, 1) Then
                        MsgBox "dato non uguale "
                        cl.Activate
                        irow1 = wk1.Sheets("foglio1").Range("a" & Rows.Count).End(xlUp).Row + 1
                        ActiveCell.Cells.Offset(0, -1).Resize(1, 5).Copy wk1.Sheets("foglio1").Cells(irow1, 1)
                    End If
                Next
                wk.Close
            Next
        End If
    Next
    With Application
        .ScreenUpdating = True
    End With
    Set wk = Nothing
    Set sh = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing

End Sub