VBA-Beispiel 092
mail schreiben
mail schreiben

Exceltabelle aus mehreren Exceldateien importieren
Kopiert aus den Dateien Dortmund, Hamburg und Kassel.xls jeweils die Spalten A bis D der Tabellen "Verkauf" in diese Tabelle.
Sub importieren()
Dim Quelle As Object, Ziel As Object
Dim letzte_Zeile As Long, Spalte As Long
Dim i As Integer
Dim Datei() As Variant

On Error GoTo Hell
Application.ScreenUpdating = False
Set Ziel = ThisWorkbook.ActiveSheet

Datei = Array("Dortmund", "Hamburg", "Kassel")
Spalte = 1

For i = 0 To UBound(Datei)
 'Quelldatei öffnen
  Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Datei(i) & ".xls"
  Set Quelle = ActiveWorkbook.Worksheets("Verkauf")

  If i = 0 Then  
    letzte_Zeile = Ziel.[A65536].End(xlUp).Row + 1
  ElseIf i = 1 Then
    letzte_Zeile = Ziel.[F65536].End(xlUp).Row + 1
  Else
    letzte_Zeile = Ziel.[K65536].End(xlUp).Row + 1
  End If

 'Spalte A bis D kopieren und einfügen
  Quelle.Range(Cells(1, 1), Cells([A65536].End(xlUp).Row, 4)).Copy _
  Ziel.Cells(letzte_Zeile, Spalte)

 'ActiveWorkbook.Close
  Workbooks(Datei(i) & ".xls").Close
  Spalte = Spalte + 5
Next

'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Application.ScreenUpdating = True

Exit Sub

Hell:
Application.ScreenUpdating = True
Set Quelle = Nothing
Set Ziel = Nothing
    MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
    & "Beschreibung: " & Err.Description _
    , vbCritical, "Fehler"
End Sub
Download:   vba092.zip
relevante Links:

top