VBA извлекает рабочие листы из различных данных Excel

Question

У меня большая проблема с моим макросом VBA, и я не могу найти решение, поэтому я надеюсь, что вы, ребята, можете это сделать.

Я хотел бы извлечь листы из различных данных Excel, скопировать их и вставить Извлекать рабочие листы в мой основной Excel.

В последней версии Excel вставляет все один за другим, но он должен вставлять весь рабочий лист в новый.

Это код ...

Public Sub Daten_mehrerer_Dateien_zusammenfuehren()

On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long

Set WBZ = ActiveWorkbook
'Altdaten auf Zielblatt löschen
WBZ.Worksheets(1).Range("A2:IV65536").ClearContents

varDateien = _
Application.GetOpenFilename("Datei (*.xlsx),*.xls", False, "Bitte gewünschte Datei(en) markieren", False, True)

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
End With

For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(filename:=varDateien(lngAnzahl))
  lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
  WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _
  Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row + 1)
WBQ.Close
Next

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
End With

MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64

Exit Sub

errExit:
With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
End With

If Err.Number = 13 Then
MsgBox "Es wurde keine Datei ausgewählt"
  Else
MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
& "Fehlernummer: " & Err.Number & vbCr _
& "Fehlerbeschreibung: " & Err.Description
End If

End Sub

Заранее спасибо!