Hallo,

ich importiere Daten aus einer anderen Tabelle (Quelle.xlsm) und kopiere mehrere der Sheets (Alpha, Beta, Gamma...) jeweis den Bereich A1 bis A500 in Eingabe.xlsm meine arbetis Tabelle mit dem Sheets Namen Auswertung in Spalte A2, B2, C2, D2 und E2. 

Zum auswählen der Quelldatei verwende ich DateiÖffnen Dialog, so weit so gut funktioniert auch alles.

Jedoch möchte ich das überspringen, wenn die Quelle.xlsm bereiches geöffnet ist, damit ich immer die aktuellen Daten kopiere.

Kann mir bitte jemand den Code mit der passenden funktion erweitern

Dankeschön

Option Explicit

Sub Daten_Importieren()
  Dim WBZiel As Workbook
  Dim ExportDatei As Variant
  Dim WBQuelle As Workbook
  Dim WSZiel As Worksheet
  
  Set WBZiel = ThisWorkbook
  
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
  'DateiÖffnen Dialog anbieten
  ExportDatei = Application.GetOpenFilename("Excel-Dateien, *.xlsm", , "Bitte die Datei zum Kopieren öffnen ...")
  ExportDatei = CStr(ExportDatei)
  
  If ExportDatei = "Falsch" Then Exit Sub
  'öffnen der ausgewählten Datei
  Set WBQuelle = Workbooks.Open(ExportDatei)
  'kopieren des Blattinhaltes und Schließen der Quell-Datei wenn nötig
  With WBQuelle
     .Sheets("Alpha").Range("A3:A500").Copy WBZiel.Sheets("Auswertung").Range("A2")
     .Sheets("Beta").Range("A3:A500").Copy WBZiel.Sheets("Auswertung").Range("B2")
     .Sheets("Gamma").Range("A3:A500").Copy WBZiel.Sheets("Auswertung").Range("C2")
     .Sheets("Delta").Range("A3:A500").Copy WBZiel.Sheets("Auswertung").Range("D2")
     .Sheets("Epsilon").Range("A3.A500").Copy WBZiel.Sheets("Auswertung").Range("E2")
     '.Close savechanges:=False ' Tabelle Schließen
  End With
  WBZiel.Sheets("Auswertung").Activate
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True

End Sub