Office: Importmakro funktioniert nicht richtig

Hallo Zusammen,

dies ist mein erster Beitrag hier, und ich hoffe das ihr mir vielleicht helfen könnt, kenne mich kaum mit Makros aus, bin zwar mit Google schon ein gutes Stück weiter gekommen, aber leider klappt es nicht ganz so wie ich mag. :)

Folgende Aufgabe möchte ich per Makro lösen: Ich möchte alle xlsx Dateien die mit einem bestimmen Dateinamen beginnen in eine Datei importieren. Dabei soll das Ergebnis aber erst ab Zeile 3 eingetragen werden in meiner Datei, weil ich darüber fixierte Zeilen habe mit Informationen.

Folgenden Code habe ich bisher zusammen bekommen

Code:

Sub Bewertungen_importieren()
  '
  Dim Pfad As String, ReportName As String
  Dim Blatt As String, Mappe As String
  '
  Blatt$ = "Tabelle1"
  Mappe$ = ActiveWorkbook.Name
  Sheets(Blatt$).Columns("A:AA").ClearContents
  '
  Pfad$ = "\\192.168.20.250\daten$\Callcenter\QM\Kurzbewertungen\"
  ReportName$ = "2013_12_" & "*.xlsx"
  ReportName$ = Dir(Pfad$ & ReportName$, vbNormal)
  Workbooks.Open Filename:=Pfad$ & ReportName$
  '
  Columns("A:I").Copy
  Workbooks(Mappe$).Sheets(Blatt$).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  '
  ActiveWorkbook.Close
  Sheets("Tabelle1").Activate
  '
End Sub

Leider wird nur eine Datei und nicht alle importiert, wie kann ich das lösen?

LG
Martin

 

Hallo Martin,

mangels an Dateien konnte ich nachfolgendes Makro nicht testen, aber ich hoffe, dass es funktionieren müsste.
Dabei habe ich angenommen, dass alle gefundenen Arbeitsmappen/Blätter in das gleiche Arbeitsblatt "Tabelle1", beginnend bei Zeile 3, importiert werden. Ferner habe ich Dir etwas Kommentar eingefügt, damit der Code leichter zu verstehen ist.

Code:

Sub Bewertungen_importieren()
  '
  Dim Pfad As String, ReportName As String
  Dim Blatt As String, Mappe As String, Zeile As Long
  '
  Blatt$ = "Tabelle1"
  Mappe$ = ActiveWorkbook.Name
  Sheets(Blatt$).Columns("A:AA").ClearContents
  '
  Pfad$ = "\\192.168.20.250\daten$\Callcenter\QM\Kurzbewertungen\"
  ReportName$ = "2013_12_*.xlsx"
  
  'Suche 1.Datei, die dem Suchmuster entspricht (und merke dir das Suchmuster):
  ReportName$ = Dir(Pfad$ & ReportName$, vbNormal)
  'Zeilennummer der 1.Datenzeile:
  Zeile = 3
  Do
    'Öffne die gefundene Arbeitsmappe, die zur aktiven Arbeitsmappe wird:
    Workbooks.Open Filename:=Pfad$ & ReportName$
    '
    'Kopiere die Spalten A-I des aktiven Blattes
    'der aktiven Arbeitsmappe in die Zwischenablage:
    ActiveSheet.Columns("A:I").Copy
    With Workbooks(Mappe$).Sheets(Blatt$)
      'Füge ab Zeilennummer "Zeile" den Inhalt der Zwischenablage (in das "Blatt$" der "Mappe$") ein:
      .Cells(Zeile, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      'Ermittle Zeilennummer der nächsten freien Datenzeile:
      Zeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
    End With
    ActiveWorkbook.Close
    '
    'Suche nächste Datei, die dem gespeicherten Suchmuster entspricht:
    ReportName$ = Dir()
    'Wenn ReportName$="", dann gibt es keine weitere Datei -> brich die Schleife ab
  Loop While Len(ReportName$)
  '
  Application.CutCopyMode = False
  Sheets(Blatt$).Activate
  '
End Sub