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!
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?
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 :)
Hallo,
Zitat:... 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:
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.
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! :)
(20.09.2016, 14:49)BadHabiit schrieb: [ -> ]Wäre cool wenn mir jemand diesen Code so umschreiben könnte.
push!
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