Do ... Loop beenden ohne Fehlermeldung

Public Sub Konsolidieren()
Dim strFileName As String
Dim objWorkbook As Workbook
Dim i As Integer
Dim strFilter As String
Dim strString As String
Dim rngCell As Range
'Errorhandler initialisieren
On Error GoTo err_exit
'DateiÖffnen Dialog
strFilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren
ChDrive "Z"
ChDir "Q:\XX\XX\" '** Laufwerk und Pfad definieren
strFileName = Application.GetOpenFilename(strFilter)
'Schleife
If strFileName  "" Then
Do
'Excelmappe öffnen
Set objWorkbook = Workbooks.Open(Filename:=strFileName)
'Die eigentliche Aufgabe: verbundene Zellen auflösen, Spalte G wird dadurch überflüssig  _
--> löschen, Spalte F Autofit
For i = 1 To objWorkbook.Worksheets.Count
With objWorkbook.Worksheets(i)
.UsedRange.Cells.UnMerge
.Columns("G:G").Delete
.Columns("F:F").AutoFit
End With
Next i
'Optisches Aufpeppen
For i = 1 To objWorkbook.Worksheets.Count
With objWorkbook.Worksheets(i)
strString = "Bitte senden.."
Set rngCell = Worksheets(i).Columns(1).Find(strString, lookat:= _
xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not rngCell Is Nothing Then
rngCell.Copy rngCell.Offset(, 4)
rngCell.ClearContents
End If
End With
Next i
'Excelmappe schließen - ohne zu speichern = False / mit speichern = True
objWorkbook.Close SaveChanges:=True
Dim a As String
a = MsgBox("Die Datei wurde gespeichert", vbYes)
'nächste Excelmappe suchen
strFileName = Application.GetOpenFilename(strFilter)
'wird keine Mappe mehr gefunde Schleife verlassen
Loop Until strFileName = ""
End If
Exit Sub
err_exit:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehlermeldung"
End Sub