Sub DBF()

    Dim myPath As String, myName As String, Wb As Workbook, clTarget As Range
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "??????? ??????? ?????"
        .Show
        If .SelectedItems.Count =  0  Then Exit Sub
        myPath = .SelectedItems( 1 ) & Application.PathSeparator
    End With
    
    myName = Dir(myPath & "*.dbf")
    With ThisWorkbook.Sheets( 1 )
        Do While myName <> ""
            Set Wb = Workbooks.Open(Filename:=myPath & myName)
            ActiveSheet.UsedRange.Copy .Cells(.UsedRange.Rows.Count + .UsedRange.Row, "A")

            Wb.Close SaveChanges:=False
            myName = Dir
        Loop
    End With
    
End Sub