Hallo ihr Lieben,
ich bin gerade dabei einen vorhandenes Makro umzuschreiben, komme jedoch irgendwie nicht weiter.
Ich möchte das mein Makro,
1. bestimmte Inhalte aus mehreren Dateien (welche auch in Unterordnern liegen) ausliest und in einer Arbeitsmappe ausgibt.
Ich habe es bereits geschafft, dass mein Makro mit die Inhalte ausliest und ausgibt, aber leider noch nicht für die Unterordner.
2. Wenn mein Makro die Liste erstellt hat, möchte ich das die Zellen mit einer anderen Arbeitsmappe verglichen werden, damit ich sehe was schon vorhanden ist und was ich noch erstellen muss. Nennen wir die andere Arbeitsmappe einfach mal Test.xlsx
3. Ist es möglich, dass das Makro ,wenn er die Arbeitsmappen miteinander verglichen hat, die Arbeitsmappen die nicht mehr benötige gleich löscht und die ich noch brauche gleich erstellt?
Punkt 3 wäre klasse, aber nicht so wichtig.
Könnt ihr mir weiterhelfen?
Code:
Private Sub CommandButton1_Click() Dim oTargetSheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Dim oFileDialog As FileDialog
Application.ScreenUpdating = True 'Das "Flackern" ausstellen
Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With oFileDialog
.Title = "Importverzeichnis wählen..."
.ButtonName = "Import"
If .Show = -1 Then sPfad = .SelectedItems(1)
End With
If Trim(sPfad) = "" Then Exit Sub
If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
Set oTargetSheet = ActiveWorkbook.Sheets("Liste")
lErgebnisZeile = 2 'Ergebnisse eintragen ab Zeile 2
Do While sDatei <> ""
'Schritt 3: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
'Datenübertragung
'Spalte 2 - Zelleninhalt A1 vom Arbeitsblatt "Kunde"
oTargetSheet.Cells(lErgebnisZeile, 1).Value = _
oSourceBook.Sheets("Kunde").Cells(2, 10).Value
oTargetSheet.Cells(lErgebnisZeile, 2).Value = _
oSourceBook.Sheets("Kunde").Cells(2, 1).Value
oTargetSheet.Cells(lErgebnisZeile, 3).Value = _
oSourceBook.Sheets("Kunde").Cells(2, 11).Value
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
lErgebnisZeile = lErgebnisZeile + 1 'nächste Zeile auf dem Ergebnisblatt
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
'Variablen aufräumen
Set oTargetSheet = Nothing
Set oSourceBook = Nothing
End Sub
[Diese Nachricht wurde von janemu am 25. Okt. 2016 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP