Tabelle per VBA in andere kopieren

[Fips]

Hallo zusammen,

ich habe mir bereits hier im Forum und anderswo verschiedene Threads zu diesem Problem angeguckt, aber bin selber noch nicht auf die Lösung gekommen, da ich vermutlich zu wenig VBA Kenntnisse besitze.

Mein Problem:

Ich habe eine Masterdatei und ca. 100 weitere Dateien (Länder) in einem Ordner. Diese ca. 100 Dateien sind alle nach dem gleichen Muster aufgebaut. In einer Masterdatei habe ich auf Blatt 1 in A4 ein Dropdown Menü mit den ca. 100 verschiedenen Ländern erstellt. Nun möchte ich, dass auf Blatt 2 in der Masterdatei die Zeilen A7:X26 bzw. das ganze Blatte aus der entsprechenden Datei des Landes angezeigt werden.

Bsp.: Ich habe in der Masterdatei in Blatt 1 A4 "Frankreich" ausgewählt und auf Blatt 2 erscheint automatisch die Tabelle aus der Datei "Frankreich.xlsx". Wenn ich nun "Schweiz" auswähle, dann wird die Tabelle auf Blatt 2 entsprechend dem Land geändert.

Mein aller erster Gedanke war es, die alles für eine sehr lange verschachtelte WENN Funktion zumachen, aber die ist viel zu aufwendig und fehleranfällig.

Vermutlich hilft ein Makro viel effizienter und schneller weiter, jedoch weiß ich nicht genau, wie dieses aussehen sollte. Habe mir bspw. hier und hier Lösungsansätze angeguckt, aber die bringen mich leider auch nicht wirklich weiter. Vermutlich habe ich zu wenig Ahnung.

Ich hoffe ich konnte mein Problem gut genug beschreiben. Bei weiteren Rückfragen, bitte einfach stellen. Vielen Dank im Voraus.

[Fips]

Code:

Option Explicit
Sub AlleEinlesen()
'Konstantendeklaration
'String
'fuer Pfad der Dateien - Beachte abschliessenden Backslash!
Const strPath$ = "\\XXX\"
'Zielblatt in dieser Mappe
Const strSheet$ = "Tabelle4"
'Datenbereich in Quellmappe
Const strSRange$ = "C4:I28"
'Integer
'Zielspalte in dieser Mappe
Const iCol% = 1
'Variablendeklarationen
'Text
Dim strFile$
  'Bildschirmflackern aus
  Application.ScreenUpdating = False
  'Verzeichnisinhalt auslesen
  strFile = Dir(strPath & "*.xlsx")
  'Schleife, solange ein Verzeichniseintrag gefunden wird
  Do While strFile <> ""
     'Quellmappe oeffnen
     Workbooks.Open strPath & strFile
     'Bereich kopieren und hier einfuegen
     ActiveWorkbook.Worksheets(1).Range(strSRange).Copy ThisWorkbook.Sheets(strSheet).Cells(ThisWorkbook.Sheets(strSheet).Cells(Rows.Count, 1).End(xlUp).Row + 1, iCol)
     'Naechsten Verzeichniseintrag ermitteln
     strFile = Dir()
     'Quellmappe schliessen
     ActiveWorkbook.Close False
  'Ende Schleife, solange ein Verzeichniseintrag gefunden wird
  Loop
  'Bildschirmflackern ein
  Application.ScreenUpdating = True
End Sub

Also mit diesem Code aus dem Forum hier schaffe ich es jetzt alle notwendigen Daten ALLER Länder in das Blatt 2 der Masterdatei zu kopieren. Was ich jedoch noch nicht schaffe, ist bspw. folgenden Code zu integrieren, damit ich mir das Land aussuchen kann:

Code:

ActiveSheet.Range("B10").Value

[Kuwer]

Hallo Fips,

Sub EinsEinlesen()
 'Konstantendeklaration
 'String
 'fuer Pfad der Dateien - Beachte abschliessenden Backslash!
 Const strPath$ = "\\XXX\"
 'Zielblatt in dieser Mappe
 Const strSheet$ = "Tabelle4"
 'Datenbereich in Quellmappe
 Const strSRange$ = "C4:I28"
 'Integer
 'Zielspalte in dieser Mappe
 Const iCol% = 1
 'Variablendeklarationen
 'Text
 Dim strFile$
 'Bildschirmflackern aus
 Application.ScreenUpdating = False
 'Verzeichnisinhalt auslesen
 'strFile = Dir(strPath & "*.xlsx")
 strFile = ActiveSheet.Range("B10").Value & "*.xlsx"
 'Schleife, solange ein Verzeichniseintrag gefunden wird
 'Do While strFile <> ""
    'Quellmappe oeffnen
    Workbooks.Open strPath & strFile
    'Bereich kopieren und hier einfuegen
    ActiveWorkbook.Worksheets(1).Range(strSRange).Copy ThisWorkbook.Sheets(strSheet).Cells(ThisWorkbook.Sheets(strSheet).Cells(Rows.Count, 1).End(xlUp).Row + 1, iCol)
    'Naechsten Verzeichniseintrag ermitteln
    'strFile = Dir()
    'Quellmappe schliessen
    ActiveWorkbook.Close False
 'Ende Schleife, solange ein Verzeichniseintrag gefunden wird
 'Loop
 'Bildschirmflackern ein
 Application.ScreenUpdating = True
End Sub

Gruß Uwe

[Fips]

Perfekt, so hat es (mit ein paar Anpassungen) funktioniert!