Sub ImportDBF()

    Dim wb As Workbook, new_wb As Workbook
    Dim filePath As String, fileName As String
    Dim copy_rng As Range, rng As Range
    Dim bNewOpen As Boolean
    bNewOpen = False
    
    Application.ScreenUpdating = False
    
    Set new_wb = Workbooks.Add       'создание новой книги
    Set copy_rng = new_wb.Sheets(1).Range("A1")

    filePath = "C:\Users\User\Desktop\1" ' < Укажите путь к папке
    
    fileName = Dir(filePath & "\*.dbf")
    
    
    ' Открытие DBF в Excel как отдельной книги в цикле
    Do Until fileName = ""
        Set wb = Workbooks.Open(filePath & "\" & fileName)
        
        ' Копирование содержимого на  лист
        If bNewOpen Then
            Set rng = wb.Sheets(1).UsedRange
            rng.Offset(1).Resize(rng.Rows.Count - 1).Copy Destination:=copy_rng
        Else
            Set rng = wb.Sheets(1).UsedRange
            rng.Copy Destination:=copy_rng
            bNewOpen = True
        End If
        
        ' Закрытие книги DBF без сохранения
        wb.Close False
        fileName = Dir()
        Set copy_rng = new_wb.Sheets(1).UsedRange
        Set copy_rng = new_wb.Sheets(1).Cells(copy_rng.Rows.Count + 1, "A")
    Loop
    Application.ScreenUpdating = True
        
End Sub

filePath = "C:\Users\User\Desktop\1"

filePath = ThisWorkbook.Path