mehrere Dateien importieren

[BadHabiit]

Hallo zusammen,

ich habe ein Makro das mir bestimmte Zellen von einer anderen Excel Datei in meine Haupt Datei importiert. Sobald ich auf den Button klicke kann ich die Datei auswählen.
Jetzt hätte ich gerne das ganze so, dass wenn ich auf den Button klicke mir alle Dateien die sich in einem bestimmten Ordner befinden in diese Datei importiert wird. (am besten ohne eine Datei auswählen zu müssen)

Anbei der aktuelle Code.

Code:

Option Explicit

Sub Import_mit_Dialog()
Dim Quelle As Object, Ziel As Object
Dim Datei As String

On Error GoTo Fehler

'Löscht den Inhalt
   Worksheets("Datenquelle").Range("B2:J10000").Clear


'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.xlsx),*xlsx")
       
'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)

 With Range("B2:J10000")
   .Copy _
     Destination:=Workbooks("PMB Ausland.xlsm").Sheets("Datenquelle").Range("B2")
 End With
ActiveWorkbook.Close SaveChanges:=False

'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"

Danke schonmal für eure Hilfe!

[Käpt'n Blaubär]

Hallo,

1. Kopierfehler: (ich nehme doch schwer an, daß es ein Kopierfehler ist)
jedenfalls fehlt das End Sub


... und eher der Ordnung halber:
2. es werden Dir nicht nur die Dateien sondern auch die in dieser Hirarchie
befindlichen Ordner angezeigt (ist das gewollt ?)

3. es werden derzeit nur *.xlsx-Dateien angezeigt.
Es gibt z.Zt. keine Anzeigen auf etwa vorhandene *.xlsm-, *.xlsb- oder *.xls-Dateien.


... was ich nun gar nicht verstanden habe:
4. im angezeigten Fenster existieren doch schon jetzt bereits zwei Buttons, einer
zum "Öffnen" und einer für den "Abbruch".

Willst Du einen zusätzlichen Button? Was soll der dann können?

[BadHabiit]

Guten Morgen,

Sorry, hab das End Sub vergessen ^^

mit diesem Makro ist es mir nur möglich eine Datei auszuwählen. Und eine Datei zu importieren

Ich würde aber gerne mehrere Dateien aufeinmal in die Liste importieren, die sich in einem bestimmten Ordner befinden,
ohne überhaupt eine Datei auswählen zu müssen.

Danke schonmal für deine Hilfe :)

[Käpt'n Blaubär]

Hallo,

... Ich würde aber gerne mehrere Dateien aufeinmal in die Liste importieren, die sich in einem bestimmten Ordner befinden,
ohne überhaupt eine Datei auswählen zu müssen.

heißt mehrere alle ?
wenn nicht, wie soll Excel dann wissen, welche Dateien Du öffnen willst und welche nicht?
Bei nicht alle, wirst Du, meiner bescheidenen Meinung nach eher Dateien auswählen müssen müssen :19:

Mehrere Dateien zu öffnen, die im gleichen Ordner wie die aufrufende Datei liegen könnte man
auch automatisch, oder eben nach Auswahl, in der rufenden Datei per VBA verdrahten. Auch
schließen ließen sie sich vollautomatisch.

Man braucht eben immer noch einige Infos mehr. So sieht es jetzt aus:

[Käpt'n Blaubär]

Hallo,

soeben ist mir eingefallen, es gibt auch noch die Möglichkeit, Dateien im Autostartordner
abzulegen. Allerdings würden diese Dateien dann jedes Mal beim Excelstart mitgestartet.
Manchmal ist das sehr vorteilhaft, aber nicht immer ist es gewünscht.

Außerdem, nicht ganz so schlimm wie oben, gibt es die Möglichkeit, mehrere Dateien zu
einem "Arbeitsbereich" zusammenzufassen. Der würde dann mit dem Start der rufenden
Datei aktiviert werden.

[BadHabiit]

Hallo,

mit mehrere meine ich alle Dateien die sich in diesem Ordner befinden.

Importiert werden soll immer Arbeitsblatt 1 Range("B2:J10000")

Es wäre auch in Ordnung wenn ich alle Dateien auswählen könnte und diese dann alle untereinander importiert werden.

Code:

Option Explicit

Sub Import_mit_Dialog()
Dim Quelle As Object, Ziel As Object
Dim Datei As String

On Error GoTo Fehler

'Löscht den Inhalt
  Worksheets("Datenquelle").Range("B2:J10000").Clear


'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.xlsx),*xlsx")
     
'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)

With Range("B2:J10000")
  .Copy _
    Destination:=Workbooks("PMB Ausland.xlsm").Sheets("Datenquelle").Range("B2")
End With
ActiveWorkbook.Close SaveChanges:=False

'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"

End Sub

Wäre cool wenn mir jemand diesen Code so umschreiben könnte.

Dankesehr! :)

[Rabe]

Wäre cool wenn mir jemand diesen Code so umschreiben könnte.

push!

[Kuwer]

Hallo,

das ist das Gleiche wie hier: http://www.clever-excel-forum.de/thread-...l#pid19775

' **************************************************************
'  Modul:  Modul2  Typ = Allgemeines Modul
' **************************************************************

Option Explicit

Sub AlleEinlesen()
 'von hier kopiert:
 'http://www.clever-excel-forum.de/thread-2338-post-19775.html#pid19775
 
 Dim lngAnzahlSpalten As Long
 Dim lngAnzahlZeilen As Long
 Dim lngStartzeile As Long
 Dim lngZaehler As Long
 Dim strDatei As String
 Dim strPfad As String
 Dim wsZiel As Worksheet
 
 lngAnzahlSpalten = 9
 lngAnzahlZeilen = 999
 lngStartzeile = 2                                'erste Zeile im Zielblatt
 strPfad = ThisWorkbook.Path & "\"                'Pfad anpassen
 Set wsZiel = ThisWorkbook.Worksheets("Tabelle1") 'Zielblatt anpassen
 
 'Bildschirmflackern aus
 Application.ScreenUpdating = False
 
 'Zielbereich erst einmal leeren
 With wsZiel
   .Range(.Cells(lngStartzeile, 1), .Cells(.Rows.Count, .Columns.Count)) = ""
 End With
 
 strDatei = Dir(strPfad & "*.xls*")  'erste Datei im Verzeichnis
 
 Do While strDatei <> ""   'Schleife, solange eine Datei gefunden wurde
   If strDatei <> ThisWorkbook.Name Then 'nur andere Dateien werden geöffnet
     With Workbooks.Open(Filename:=strPfad & strDatei, ReadOnly:=True)
       'Bereichsübertrag
       wsZiel.Cells(lngStartzeile + lngAnzahlZeilen * lngZaehler, 1).Resize(lngAnzahlZeilen, lngAnzahlSpalten).Value = _
        .Worksheets(1).Cells(2, 2).Resize(lngAnzahlZeilen, lngAnzahlSpalten).Value
       .Close False  'Quellmappe schliessen
     End With
     lngZaehler = lngZaehler + 1
   End If
   strDatei = Dir() 'Naechste Datei im Verzeichnis ermitteln
 Loop
 
 'Bildschirmflackern ein
 Application.ScreenUpdating = True
 
 MsgBox "Es wurden " & lngZaehler & " Dateien übertragen.", vbInformation
End Sub

Gruß Uwe