VBA Bestimmte Zellen aus mehreren Dateien zusammen

Sub Übertragen()
Dim Datei As Variant
Dim Quelle, Ziel As String
Dim bExists, MappeOffen As Boolean
Dim i As Integer
Dim lZeile As Long
Dim Rückgabe
'Datei-Öffnen Dialog aufrufen
Datei = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xl*), *.xl*",  _
Title:="Datei(en) auswählen", MultiSelect:=True)
If Datei = False Then
Exit Sub
End If
'Prüfen, ob Datei schon offen ist
For i = 1 To Workbooks.Count
If Workbooks(i).FullName = Datei Then
'ausgewählte Mappe ist bereits offen
MappeOffen = True
'Frage, ob Daten kopiert werden sollen
Rueckgabe = MsgBox("Die Arbeitsmappe " & Quelle & " ist bereits offen! Sollen die Daten  _
kopiert werden?", vbYesNo + vbQuestion, "Mappe bereits offen")
'Abbruch des Makros
If Rueckgabe = vbNo Then Exit Sub
'Name der Quelldatei in Variable schreiben
Quelle = Workbooks(i).Name
End If
Next i
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'ausgewählte Datei öffnen, falls diese noch nicht offen ist
If MappeOffen = False Then
Workbooks.Open (Datei)
'Name der Quelldatei in Variable schreiben
Quelle = ActiveWorkbook.Name
End If
'Name der Zielarbeitsmappe wird in Datei geschrieben
Ziel = ThisWorkbook.Name
'Prüfen, ob Tabellenblatt mit Namen Sheet1 in Quelldatei existiert
For i = 1 To Workbooks(Quelle).Sheets.Count
If Workbooks(Quelle).Sheets(i).Name = "Sheet1" Then
bExists = True: Exit For
End If
Next i
'Abbruch des Makros falls kein Arbeitsblatt mit dem Namen Sheet1 existiert
If bExists = False Then
MsgBox "In der Arbeitsmappe " & Quelle & " existiert kein Arbeitsblatt mit dem Namen Sheet1!    _
_
_
Abbruch!", 16, "Fehlermeldung"
Exit Sub
End If
'Festlegen der Zeile zum Einfügen der Daten in Tabelle1
lZeile = Workbooks(Ziel).Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'Prüfen, ob erste Zeile leer ist, falls ja, Zeilenzähler auf 1 setzen
If Workbooks(Ziel).Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row = 1 Then
If IsEmpty(Workbooks(Ziel).Sheets("Tabelle1").UsedRange) Then lZeile = 1
End If
'Kopieren der Daten - E3 wird nach Spalte A kopiert
Workbooks(Quelle).Sheets("Sheet1").Range("b2").Copy
Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 1).PasteSpecial Paste:=xlPasteValues 'Werte    _
_
_
kopieren
'Kopieren der Daten - E3 wird nach Spalte A kopiert
Workbooks(Quelle).Sheets("Sheet1").Range("c2").Copy
Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 2).PasteSpecial Paste:=xlPasteValues 'Werte    _
_
_
kopieren
'Kopieren der Daten - E3 wird nach Spalte A kopiert
Workbooks(Quelle).Sheets("Sheet1").Range("f2").Copy
Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 3).PasteSpecial Paste:=xlPasteValues 'Werte    _
_
_
kopieren
'P3 wird nach Spalte B kopiert
Workbooks(Quelle).Sheets("Sheet1").Range("b7").Copy
Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 11).PasteSpecial Paste:=xlPasteValues
'P4 wird nach Spalte C kopiert
Workbooks(Quelle).Sheets("Sheet1").Range("b10").Copy
Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 12).PasteSpecial Paste:=xlPasteValues
'K52 wird nach Spalte D kopiert
Workbooks(Quelle).Sheets("Sheet1").Range("f25").Copy
Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 13).PasteSpecial Paste:=xlPasteValues
'Quelldatei schließen, wenn diese über das Makro geöffnet wurde
If MappeOffen = False Then Workbooks(Quelle).Close SaveChanges:=False
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
End Sub