Daten aus mehreren Excel-Dateien importieren mit V

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Daten aus mehreren Excel-Dateien importieren mit V
von: Anja Schnappauf
Geschrieben am: 09.09.2015 14:08:54

An alle Excelhelden…
Ist es möglich in alle Dateien aus einem Ordner in eine Tabelle zu importieren?
Ich habe eine Datei mit mehreren Tabellenblättern. Jetzt möchte ich dort Daten aus anderen Excel-Dateien importieren. Die zu importierenden Dateien befinden sich alle in einem Ordner. Ich möchte gerne einen Button haben, der das sozusagen automatisch erledigt.
Hauptdatei
Datei in die die Daten importiert werden sollen.
Die Daten sollen auf Tabellenblatt „Sachbearbeiter“ importiert werden.
Und zwar ab Zelle A 16
Spalten: A-Q
Aufbau gleich dem der Importdateien (Gleiche Spaltenanzahl und Überschriften)
Import Dateien
Mehrere Dateien in gleichem Ordner
Unterschiedliche Dateinamen
Sind alle gleich aufgebaut (Gleiche Spaltenanzahl und Überschriften)
Zeilenanzahl variabel, da der Inhalt unterschiedlich lang ist.
Name Tabellenblatt aus dem die Daten ausgelesen werden sollen: VerfahrenslisteSB
Spalten: A-Q
Ich habe einen Code mit dem ich eine Datei importieren kann, welcher super läuft. Ich weiß aber nicht, wie ich ihn so anpassen kann, dass er mehrere Dateien ausliest. Die Daten müssten schließlich untereinander angeordnet werden, damit bereits vorhandener Inhalt nicht überschirieben wird, wenn bereits z.B. die erste Datei importiert wurde. Das heißt, der Code müsste prüfen wo die letzte benutzte Zeile ist, um die folgenden Daten darunter einzutragen.
Ich würde mich freuen, wenn jemand sich darüber sein Superhirn zerbrechen würde. Danke im Voraus.
Anja
Mein Code:

Private Sub cmdImport_Click()
Application.ScreenUpdating = False
Dim Quelle As Object, Ziel As Object
Dim Datei As String
On Error GoTo Fehler
'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
    "*.xls; *.xlsx; *.xlsm")
      
'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then
  MsgBox "keine Datei ausgewählt", , "Abbruch"
  Exit Sub
End If
'MsgBox "Ausgewählte Datei: " & Datei, , ""
  
'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(1)
'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(2, 1)
ActiveWorkbook.Close
 
'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Exit Sub
Fehler:
Set Quelle = Nothing
Set Ziel = Nothing
    MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
    & "Beschreibung: " & Err.Description _
    , vbCritical, "Fehler"
    
  Application.ScreenUpdating = True
    
End Sub

Bild

Betrifft: AW: Daten aus mehreren Excel-Dateien importieren mit V
von: Anja Schnappauf
Geschrieben am: 09.09.2015 14:12:07
habe vergessen zu erwähnen das die Daten in den Importdateien auch erst ab Zeile 16 (A16)beginnen.
Also von Importdatei A16-Q? in Hauptdatei A 16-O?....

Bild

Betrifft: AW: Daten aus mehreren Excel-Dateien importieren mit V
von: fcs
Geschrieben am: 09.09.2015 16:47:55
Hallo Anja,
hier mein Lösungsvorschlag.
Gruß
Franz

Private Sub cmdImport_Click()
  
  Application.ScreenUpdating = False
  
  Dim wbQuelle As Workbook, Quelle As Worksheet, Ziel As Worksheet
  Dim Datei As Variant, varDateien
  Dim Zeile_Z As Long, Zeile_Q1 As Long, Zeile_Q2 As Long
  Dim rngZelle As Range
  
  On Error GoTo Fehler
  
  'Dialog "Datei öffnen" anzeigen
  varDateien = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
     "*.xls; *.xlsx; *.xlsm", _
     Title:="Bitte zu importieren Datei(en) auswählen", MultiSelect:=True)
  
       
  'Abbrechen falls keine Datei ausgewählt
  If Not IsArray(varDateien) Then
   MsgBox "keine Datei ausgewählt", , "Abbruch"
   Exit Sub
  End If
  
  Application.ScreenUpdating = False
  
  Set Ziel = ThisWorkbook.Worksheets("Sachbearbeiter")
  With Ziel
    'Startzeile setzen
    Set rngZelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
       lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
    If rngZelle Is Nothing Then
      Zeile_Z = 16
    Else
      Zeile_Z = rngZelle.Row
    End If
    If Zeile_Z < 16 Then
      Zeile_Z = 16
    Else
      Zeile_Z = Zeile_Z + 1
    End If
  End With
  
  'Ausgewählte Datei abarbeiten
  For Each Datei In varDateien
'    MsgBox "Ausgewählte Datei: " & Datei, , ""
    Set wbQuelle = Workbooks.Open(Filename:=Datei, ReadOnly:=True)
    
    Set Quelle = wbQuelle.Worksheets("VerfahrenslisteSB")
    With Quelle
      Zeile_Q1 = 16
      'Letzte Zeile in Quelle
      Set rngZelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
         lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
      If rngZelle Is Nothing Then
        'keine Daten
        GoTo NextDatei
      Else
        Zeile_Q2 = rngZelle.Row
      End If
      If Zeile_Q2 >= Zeile_Q1 Then
      'kopieren und einfügen
  '      .Range(.Rows(Zeile_Q1), .Rows(Zeile_Q2)).Copy Ziel.Cells(Zeile_Z, 1)
        .Range(.Cells(Zeile_Q1, 1), .Cells(Zeile_Q2, 17)).Copy Ziel.Cells(Zeile_Z, 1)
        'nächste Einfügezeile
        Zeile_Z = Zeile_Z + Zeile_Q2 - Zeile_Q1 + 1
      End If
    End With
NextDatei:
    wbQuelle.Close savechanges:=False
    
    'Speicher freigeben
    Set Quelle = Nothing
    Set wbQuelle = Nothing
  Next Datei
  
  Application.ScreenUpdating = True
  
Fehler:
  With Err
    Select Case .Number
      Case 0 'alles OK
      Case Else
          If Not wbQuelle Is Nothing Then wbQuelle.Close savechanges:=False
          MsgBox "FehlerNr.: " & .Number & vbNewLine & vbNewLine _
             & "Beschreibung: " & .Description, _
             vbCritical, "Fehler"
    End Select
  End With
  'Speicher freigeben
  Set Quelle = Nothing
  Set wbQuelle = Nothing
  Set Ziel = Nothing
  Application.ScreenUpdating = True
End Sub


Bild

Betrifft: AW: Daten aus mehreren Excel-Dateien importieren mit V
von: Anja Schnappauf
Geschrieben am: 09.09.2015 18:25:25
Hallo Franz = Excelheld,
danke, danke, danke!!!!
Der Code klappt super. Ich bin besser im Code lesen, als im Code erstellen.
Ich habe jetzt noch 2 Probleme:
1.
Ist es möglich, dass er nur Werte einfügt? Ohne Formeln und Formate?
2.
In der anderen Datei befinden sich Formeln, denen ich einen Namen gegeben habe. Das sind Listen, die ich in meinen Dropdownlisten anzeige. Diese Listen mit den selben Namen sind sowohl in der Zieldatei, als auch in den Importdateien vorhanden. Leider fragt er mich jetzt bei jeder Datei, die er einfügen will mehrmals:
Die Formel die eingefügt werden soll, enthält einen Namen, der bereits in der Zieltabelle vorhanden ist. Soll die vorhandene Definition verwendet werden?
Ich müsste das dann ca. 50 x mit Ja bestätigen. Je nachdem wie viele Dateien im Ordner vorhanden sind.
Kann man das irgendwie abschalten?
Ich habe Dateien, wo ich auch Tabellenblätter exportiere. Da verwende ich immer einen Code der die Namen löscht und den Link, damit keine Verknüpfungen vorhanden sind. Kann man das irgendwie da rein basteln, damit die Namen nicht mit "kopiert" werden?
Dim i As Integer
Dim myLinks As Variant
Dim A As Integer, MyName As Name
With ActiveWorkbook
myLinks = .LinkSources(xlExcelLinks)
If Not IsEmpty(myLinks) Then
For i = 1 To UBound(myLinks)
.BreakLink myLinks(i), xlExcelLinks

Next i
End If

With ActiveWorkbook
For Each MyName In .Names
MyName.Delete
Next
End With
Liebe Grüße
Anja

Bild

Betrifft: AW: Daten aus mehreren Excel-Dateien importieren mit V
von: fcs
Geschrieben am: 10.09.2015 05:01:14
Hallo Anja,
die Anpassung in folgendem Abschnitt scheint auszureichen, damit beide Probleme gelöst sind.

      If Zeile_Q2 >= Zeile_Q1 Then
      'kopieren und einfügen (nur Formeln und Formate)
  '      .Range(.Rows(Zeile_Q1), .Rows(Zeile_Q2)).Copy
        .Range(.Cells(Zeile_Q1, 1), .Cells(Zeile_Q2, 17)).Copy
        Application.DisplayAlerts = False
        Ziel.Cells(Zeile_Z, 1).PasteSpecial Paste:=xlPasteFormats
        Ziel.Cells(Zeile_Z, 1).PasteSpecial Paste:=xlPasteValues
        Application.DisplayAlerts = True
        Application.CutCopyMode = False 'Zwischenablage leerräumen
        'nächste Einfügezeile
        Zeile_Z = Zeile_Z + Zeile_Q2 - Zeile_Q1 + 1
      End If
Wenn du in der Quelle vor dem Kopieren bezüglich Namen, und Formel-Verknüpfungen gründlich aufräumen willst, dann sieht es wie folgt aus.
Gruß
Franz
Private Sub cmdImport_Click()
  
  Dim wbQuelle As Workbook, Quelle As Worksheet, Ziel As Worksheet
  Dim Datei As Variant, varDateien
  Dim Zeile_Z As Long, Zeile_Q1 As Long, Zeile_Q2 As Long
  Dim rngZelle As Range
  Dim objName As Name, varLinks As Variant, i As Integer
  
  On Error GoTo Fehler
  
  'Dialog "Datei öffnen" anzeigen
  varDateien = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
     "*.xls; *.xlsx; *.xlsm", _
     Title:="Bitte zu importieren Datei(en) auswählen", MultiSelect:=True)
  
       
  'Abbrechen falls keine Datei ausgewählt
  If Not IsArray(varDateien) Then
   MsgBox "keine Datei ausgewählt", , "Abbruch"
   Exit Sub
  End If
  
  Application.ScreenUpdating = False
  
  Set Ziel = ThisWorkbook.Worksheets("Sachbearbeiter")
  With Ziel
    'Startzeile setzen
    Set rngZelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
       lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
    If rngZelle Is Nothing Then
      Zeile_Z = 16
    Else
      Zeile_Z = rngZelle.Row
    End If
    If Zeile_Z < 16 Then
      Zeile_Z = 16
    Else
      Zeile_Z = Zeile_Z + 1
    End If
  End With
  
  'Ausgewählte Datei abarbeiten
  For Each Datei In varDateien
'    MsgBox "Ausgewählte Datei: " & Datei, , ""
    Set wbQuelle = Workbooks.Open(Filename:=Datei, ReadOnly:=True, UpdateLinks:=True)
    
    Set Quelle = wbQuelle.Worksheets("VerfahrenslisteSB")
    With Quelle
      Zeile_Q1 = 16
      'Letzte Zeile in Quelle
      Set rngZelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
         lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
      If rngZelle Is Nothing Then
        'keine Daten
        GoTo NextDatei
      Else
        Zeile_Q2 = rngZelle.Row
      End If
      If Zeile_Q2 >= Zeile_Q1 Then
        'Formeln im Quell-Tabellenblatt durch Werte ersetzen
        With .UsedRange
            .Value = .Value
        End With
        'Namen in Quelle löschen
        For Each objName In wbQuelle.Names
            If objName.Visible = True Then
                objName.Delete
            End If
        Next
        'Links in Quelle löschen
        varLinks = wbQuelle.LinkSources(xlExcelLinks)
        If Not IsEmpty(varLinks) Then
            For i = 1 To UBound(varLinks)
                wbQuelle.BreakLink varLinks(i), xlExcelLinks
            Next i
        End If
      'kopieren und einfügen
        Application.DisplayAlerts = False
  '      .Range(.Rows(Zeile_Q1), .Rows(Zeile_Q2)).Copy Ziel.Cells(Zeile_Z, 1)
        .Range(.Cells(Zeile_Q1, 1), .Cells(Zeile_Q2, 17)).Copy Ziel.Cells(Zeile_Z, 1)
        Application.CutCopyMode = False 'Zwischenablage leerräumen
        Application.DisplayAlerts = True
       'nächste Einfügezeile
        Zeile_Z = Zeile_Z + Zeile_Q2 - Zeile_Q1 + 1
      End If
    End With
NextDatei:
    wbQuelle.Close savechanges:=False
    
    'Speicher freigeben
    Set Quelle = Nothing
    Set wbQuelle = Nothing
  Next Datei
  
  Application.ScreenUpdating = True
  
Fehler:
  With Err
    Select Case .Number
      Case 0 'alles OK
      Case Else
          If Not wbQuelle Is Nothing Then wbQuelle.Close savechanges:=False
          MsgBox "FehlerNr.: " & .Number & vbNewLine & vbNewLine _
             & "Beschreibung: " & .Description, _
             vbCritical, "Fehler"
    End Select
  End With
  'Speicher freigeben
  Set Quelle = Nothing
  Set wbQuelle = Nothing
  Set Ziel = Nothing
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub


Bild

Betrifft: AW: Daten aus mehreren Excel-Dateien importieren mit V
von: Anja Schnappauf
Geschrieben am: 11.09.2015 00:24:48
Hallo Franz,
du bist mein Super-Excel-Hirn-Genie...
Es klappt alles perfekt. Ich habe den Code nur angepasst, weil ich die Namen aus der Quelldatei nicht löschen will und darf. Sonst funktionieren meine Formeln nicht mehr.
DAAAAAAANKE!!!
Liebe Grüße
Anja

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Daten aus mehreren Excel-Dateien importieren mit V"