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