Improving performance of VBA batch scripts?

I am using a script to open a bunch of Excel files, copying two or more sheets into a new file and saving this new file. It sure beats doing it manually, but I think it could be faster.

Here's my script:

Sub Flujo()

Const FilePath = "A path..."
Const Destination = "Another path..."

Dim app As New Excel.Application
app.Visible = False
app.ScreenUpdating = False
app.DisplayAlerts = False

Dim str As String
str = Dir(FilePath & "\*.xlsx")
Do Until str = ""

    Dim WrkBook As Workbook
    Set WrkBook = app.Workbooks.Open(Filename:=FilePath & "\" & str, UpdateLinks:=0)
    str = Dir()

    Dim NewBook As Workbook
    Set NewBook = app.Workbooks.Add

    WrkBook.Sheets("SheetName").Copy After:=NewBook.Sheets(3)
    WrkBook.Sheets("AnotherSheetName").Copy After:=NewBook.Sheets(3)

    NewBook.Sheets(1).Delete
    NewBook.Sheets(1).Delete
    NewBook.Sheets(1).Delete

    NewBook.SaveAs Filename:=Destination & "flujo_" & WrkBook.Name
    NewBook.Close False
    WrkBook.Close False
Loop

app.DisplayAlerts = True

app.Quit
Set app = Nothing
End Sub

Is there a way I could make it work faster?

-Edit- The script takes more or less 3 - 6 seconds per file. That's not too much but I feel it could be much faster. Or is this the fastest I can expect to get with VBA?

Rather than copying sheet by sheet - plus deleting three excess sheets one by one, either

• Delete the sheets you don't need then use SaveAs on the reduced file.

• Copy both sheets you need to a new file in a single hit.

(Also, don't Dim variables inside a loop)

(2) below

Sub Flujo()

Const FilePath = "A path..."
Const Destination = "Another path..."
Dim xlApp As New Excel.Application

With xlApp
    .Visible = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Dim strDir As String
Dim WrkBook As Workbook

strDir = Dir(FilePath & "\*.xlsx")

Do While Len(strDir) > 0      
Set WrkBook = xlApp.Workbooks.Open(Filename:=FilePath & "\" & strDir, UpdateLinks:=0)
  WrkBook.Sheets(Array("SheetName", "AnotherSheetName")).Copy
  ActiveWorkbook.SaveAs Filename:=Destination & "flujo_" & WrkBook.Name
  ActiveWorkbook.Close False
  WrkBook.Close False
strDir = Dir 
Loop

xlApp.DisplayAlerts = True

xlApp.Quit
Set xlApp = Nothing
End Sub

StackExchange Code Review Q#51912, answer score: 6