Kopieren von Active in ThisWorkbook

Sub Daten_importieren()
Dim wksAusw As Worksheet, wksK As Worksheet, wksE As Worksheet, wksT1 As Worksheet, _
wksT2 As Worksheet, wksT3 As Worksheet
Dim wbBA As Worksheet, wbBK As Worksheet, wbBT1 As Worksheet, wbBT2 As Worksheet, _
wbBT3 As Worksheet
Dim strPfad As String, strFileName As String, a, b
Dim wbA As Workbook, wbB As Workbook
Dim lLetzteAusw As Long, lLetzteAK As Long, lLetzteAT1 As Long, lLetzteAT2 As Long, _
lLetzteAT3 As Long
Dim lLetzteBAusw As Long, lLetzteBK As Long, lLetzteBT1 As Long, lLetzteBT2 As Long, _
lLetzteBT3 As Long
Set wbA = ThisWorkbook
Set wksAusw = wbA.Worksheets("Auswertung")
Set wksK = wbA.Worksheets("Kontrolle")
Set wksE = wbA.Worksheets("Einlesen")
Set wksT1 = wbA.Worksheets("Textablage1")
Set wksT2 = wbA.Worksheets("Textablage2")
Set wksT3 = wbA.Worksheets("Textablage3")
a = wksE.Range("J1")
b = wksE.Range("O44")
If a <> b Then
MsgBox "Für diese Ausführung muß das Passwort eingegeben werden    "
Exit Sub
Else
Application.ScreenUpdating = False   ' aktuelle Bildschirmeinstellung bleibt
strPfad = wksE.Range("K40")
ChDrive Left$(strPfad, 1)
ChDir strPfad
strFileName = Application.GetOpenFilename(FileFilter:="Exceldateien (*.xls), *.xls")
If strFileName = "Falsch" Then Exit Sub
Set wbB = Workbooks.Open(strFileName)
Set wbBA = wbB.Worksheets("Auswertung")
Set wbBK = wbB.Worksheets("Kontrolle")
Set wbBT1 = wbB.Worksheets("Textablage1")
Set wbBT2 = wbB.Worksheets("Textablage2")
Set wbBT3 = wbB.Worksheets("Textablage3")
On Error GoTo zu
'prüfen ob Kreiskürzel bereits vorhanden ist
If WorksheetFunction.CountIf(wksK.Range("E2:E65536"), wbBK.Range("E2").Value) > 0 Then
wbB.Close
MsgBox "Der Name ist breits vorhanden" & vbLf & vbLf & _
"Das Einlesen wird abgebrochen!" & vbLf
Exit Sub
Else
lLetzteBAusw = IIf(wbBA.Range("A65536") <> "", 65536, wbBA.Range("A65536").End(xlUp).Row)
lLetzteAusw = IIf(wksAusw.Range("A65536") <> "", 65536, wksAusw.Range("A65536").End(xlUp).Row)
wbBA.Range("A3:BI" & lLetzteBAusw).Copy
wksAusw.Range("A" & lLetzteAusw + 1).PasteSpecial Paste:=xlValues
lLetzteBK = IIf(wbBK.Range("A65536") <> "", 65536, wbBK.Range("A65536").End(xlUp).Row)
lLetzteAK = IIf(wksK.Range("A65536") <> "", 65536, wksK.Range("A65536").End(xlUp).Row)
wbBK.Range("A2:E" & lLetzteBK).Copy
wksK.Range("A" & lLetzteAK + 1).PasteSpecial Paste:=xlValues
lLetzteBT1 = IIf(wbBT1.Range("A65536") <> "", 65536, wbBT1.Range("A65536").End(xlUp).Row)
lLetzteAT1 = IIf(wksT1.Range("A65536") <> "", 65536, wksT1.Range("A65536").End(xlUp).Row)
wbBT1.Range("A2" & lLetzteBT1).Copy
wksT1.Range("A" & lLetzteAT1 + 1).PasteSpecial Paste:=xlValues
lLetzteBT2 = IIf(wbBT2.Range("A65536") <> "", 65536, wbBT2.Range("A65536").End(xlUp).Row)
lLetzteAT2 = IIf(wksT2.Range("A65536") <> "", 65536, wksT2.Range("A65536").End(xlUp).Row)
wbBT2.Range("A2" & lLetzteBT2).Copy
wksT2.Range("A" & lLetzteAT2 + 1).PasteSpecial Paste:=xlValues
lLetzteBT3 = IIf(wbBT3.Range("A65536") <> "", 65536, wbBT3.Range("A65536").End(xlUp).Row)
lLetzteAT3 = IIf(wksT3.Range("A65536") <> "", 65536, wksT3.Range("A65536").End(xlUp).Row)
wbBT3.Range("A2" & lLetzteBT3).Copy
wksT3.Range("A" & lLetzteAT3 + 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False 'entfernt die Zwischenspeicherung
wbB.Close
wksE.Select
Application.ScreenUpdating = True
MsgBox "Die Daten wurden erfolgreich importiert!     "
End If
End If
Exit Sub
zu:
MsgBox "Es sind nicht alle Tabellenblätter zum importieren vorhanden !   " & vbLf & vbLf & _
"                      Bitte den Eingang prüfen                  "
wbB.Close
End Sub