Excel Datei in Makro öffnen aber richtig

Sub ImportJanuar()
Dim strDatName As Variant
Dim wbA As Workbook, wbB As Workbook
Dim wsA As Worksheet, wsB As Worksheet
Dim iZeile As Long, letzteZeile As Long
Dim Suchnummer, varSuch2, boolTreffer As Boolean
Dim rngB As Range, rngFinden As Range, sErsteZelle As String
' Dateinnamen definieren
strDatName = Application.GetOpenFilename("ExcelFiles (*.XLS), *.xls")
If strDatName  False Then
Set wbB = Workbooks.Open(strDatName)
Set wbA = ThisWorkbook
Else
Exit Sub
End If
Worksheets("Jan.").Unprotect Password:=""
getMoreSpeed True
' Tabellennamen definieren
Set wsA = wbA.Worksheets(2)
Set wsB = wbB.Worksheets(2)
letzteZeile = wsB.Range("A65536").End(xlUp).Row
With wsB
'zu durchsuchender Bereich in Blatt B fur Suchnummer
Set rngB = .Range(.Cells(5, 1), .Cells(letzteZeile, 1))
End With
' Suche
For iZeile = 5 To wsA.Range("A65536").End(xlUp).Row
Suchnummer = wsA.Cells(iZeile, 1)
varSuch2 = wsA.Cells(iZeile, 6).Value
'Suchnummer in B suchen
Set rngFinden = rngB.Find(What:=Suchnummer, LookIn:=xlValues, lookat:=xlWhole)
boolTreffer = False
If Not rngFinden Is Nothing Then
'Zelladresse der 1. Fundstelle merken
sErsteZelle = rngFinden.Address
Do
'Wert in Spalte F mit 2. Suchwert vergleichen
If wsB.Cells(rngFinden.Row, 6).Value = varSuch2 Then
boolTreffer = True
Exit Do
End If
'Suche in Spalte A wiederholen
Set rngFinden = rngB.FindNext(After:=rngFinden)
Loop Until rngFinden.Address = sErsteZelle
End If
If boolTreffer = True Then
wsA.Cells(iZeile, 7) = wsB.Cells(rngFinden.Row, 7)
wsA.Cells(iZeile, 8) = wsB.Cells(rngFinden.Row, 8)
wsA.Cells(iZeile, 9) = wsB.Cells(rngFinden.Row, 9)
End If
Next iZeile
' Datei B schliessen
wbB.Close False
getMoreSpeed False
Worksheets("Jan.").Protect Password:=""
MsgBox ("Daten Januar importiert")
End Sub

' Beispiel: C:\MAPPE2.XLS (richtig!) öffnen
Dim bExists As Boolean
Dim oWorkbook As Object
' Prüfen ob Datei bereits geöffnet ist
bExists = False
With Application
For Each oWorkbook In .Workbooks
If UCase$(oWorkbook.Name) = "MAPPE2.XLS" Then
' Jetzt aktivieren
Windows(oWorkbook.Name).Activate
bExists = True
Exit For
End If
Next
End With
' Mappe neu laden!
If Not bExists Then
On Error Resume Next
Workbooks.Open Filename:="C:\MAPPE2.XLS", ReadOnly:=False
On Error GoTo 0
End If