Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
988to992
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
988to992
988to992
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dateien öffnen Werte auslesen

Dateien öffnen Werte auslesen
01.07.2008 11:38:46
Andre´
Hallo alle zusammen,
ich möchte die Zellwerte aus allen Excel Dateien die sich unter C:\ befinden auslesen.
Es handelt sich nur um die Zellen A1, B2 und B3 der Tabelle1 die in eine neue Arbeitsmappe eingelesen werden sollen.
Die nächsten Werte sollen jeweils angehängt werden.
Wie kann ich dies realiesieren.
Vielen Dank im Voraus!
MFG Andre

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien öffnen Werte auslesen
01.07.2008 11:57:40
UweD
Hallo
ich hab mal ein bestehendes Makro abgeändert:


Option Explicit
Sub alle_Dateien_Verzeichnis() '
    Dim dlg As FileDialog
    Dim Si, Ext$, Datei$
    Dim TB1, TB2, LR&
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker) 'Verzeichnis wählen
    If dlg.Show = True Then
        For Each Si In dlg.SelectedItems 'Die Abfrage für den selektierten Eintrag
            Ext = "*.xls"       'Dateiextension ggf. anpassen
            Datei = Dir(Si & "\" & Ext)
            Do
                Workbooks.Open Filename:=Si & "\" & Datei
                'mach was damit
                Set TB1 = ThisWorkbook.Sheets("Tabelle1"'Neue Tabelle dieser Datei
                Set TB2 = ActiveWorkbook.Sheets("Tabelle1"'Tabelle aus der gelesen wird
                LR = TB1.Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile der Spalte+1
                TB1.Cells(LR, 1) = TB2.Range("A1"'hier hinten sind die Zielzellen
                TB1.Cells(LR, 2) = TB2.Range("B2"'"
                TB1.Cells(LR, 3) = TB2.Range("B3"'"
                'Ende mach was
                Workbooks(Datei).Close SaveChanges:=False
                Datei = Dir() ' wählt die nächste Datei
            Loop While Len(Datei) > 0
        Next
    End If
End Sub


unklar ist mir, ob die 3 Werte, die ja aus unterschiedlichen Zeilen kommen, auch wieder in unterschiedliche Zeilen sollen?
Ich hab es jetzt so gemacht, das die Zahlenpaare in einer Zeile angefügt werden.
Gruß UweD

Anzeige
AW: Dateien öffnen Werte auslesen
01.07.2008 12:31:00
Andre´
Hallo Uwe,
vielen DANK für die Meldung. Genau das habe ich gesucht :-))
MFG Andre

AW: Dateien öffnen Werte auslesen
01.07.2008 16:17:00
Andre´
Hallo Uwe,
habe gerade festgestellt, dass es ein Problem gibt wenn ein Ordner ausgewählt wurde wo keine Dateien enthalten sind.
Code bleibt bei folgender Zeile hängen
Workbooks.Open Filename:=Si & "\" & Datei
und bringt Laufzeitfehler 1004
Hast Du eine Idee wie man das abfangen kann.
MFG Andre

AW: Dateien öffnen Werte auslesen
01.07.2008 16:36:05
UweD
Hallo
ja geht.
Ich habe das

"While Len(Datei) > 0"

and den Anfang der Loop- Schleife gesetzt...


Option Explicit
Sub alle_Dateien_Verzeichnis() '
    Dim dlg As FileDialog
    Dim Si, Ext$, Datei$
    Dim TB1, TB2, LR&
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker) 'Verzeichnis wählen
    If dlg.Show = True Then
        For Each Si In dlg.SelectedItems 'Die Abfrage für den selektierten Eintrag
            Ext = "*.xls"       'Dateiextension ggf. anpassen
            Datei = Dir(Si & "\" & Ext)
            Do While Len(Datei) > 0
                Workbooks.Open Filename:=Si & "\" & Datei
                'mach was damit
                Set TB1 = ThisWorkbook.Sheets("Tabelle1"'Neue Tabelle dieser Datei
                Set TB2 = ActiveWorkbook.Sheets("Tabelle1"'Tabelle aus der gelesen wird
                LR = TB1.Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile der Spalte+1
                TB1.Cells(LR, 1) = TB2.Range("A1"'hier hinten sind die Zielzellen
                TB1.Cells(LR, 2) = TB2.Range("B2"'"
                TB1.Cells(LR, 3) = TB2.Range("B3"'"
                'Ende mach was
                Workbooks(Datei).Close SaveChanges:=False
                Datei = Dir() ' wählt die nächste Datei
            Loop
        Next
    End If
End Sub


Anzeige
Besten Dank:-)) owt.
01.07.2008 16:47:00
Andre´

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige