Option Explicit
Sub copia()
    Dim WB As Workbook
    Dim Ws1 As Worksheet
    Dim Percorso As String, nomeFile As String, Uriga As Long
    Percorso = "C:UsersflorindaDesktopVenturedatadataset"
    Application.ScreenUpdating = False
    Set Ws1 = ThisWorkbook.Worksheets("Company Data Items ")
    nomeFile = Dir(Percorso)
    Do While nomeFile <> ""
        If nomeFile <> ThisWorkbook.Name Then
            Workbooks.Open (Percorso & "" & nomeFile)
            Uriga = Range("A" & Rows.Count).End(xlUp).Row
            Workbooks(nomeFile).ActiveSheet.Range("A2:DZ" & Uriga).Copy
            Uriga = Ws1.Range("A" & Rows.Count).End(xlUp).Row
            Ws1.Range("A" & Uriga + 1).PasteSpecial
            Application.DisplayAlerts = False
            Workbooks(nomeFile).Close False
            Application.DisplayAlerts = True
        End If
        nomeFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fatto"
    Set Ws1 = Nothing
End Sub