aus verschiedenen xls dateien auslesen und in ein formular auflisten

Question

Hallo,
ich hoff das mir jemand helfen kann...
mein problemm:

habe ca. 1200 xls dateien wo ich die adressdaten auslesen und in einer neuen datei (tabellenblatt) eintragen muss.

die auszulesenden adressdaten befinden sich immer an gleiche stelle
auszulesen ist:
Nachname
Vorname
Datum
Strasse
PLZ
Gebursdatum

ich habe eis bereist selber versucht in VBA zu schreiben bin aber gescheitert....

im voraus vielen dank

Answer 1

Hallo,

leider machst du keinerlei Angaben dazu
[list]- wo die 1.200 Dateien liegen (alle im selben Verzeichnis?)
- wie die einzulesenden Arbeitsmappen aufgebaut sind (nur ein Tabellenblatt oder mehrere und falls es mehrere Tabellen gibt, in welcher stehen die gesuchten Daten?)
- aus welchen Zellen nach welchen Zellen die Angaben kopiert werden soll (z.B. Name von Quelldatei Zelle A5 in Zieldatei in Spalte A etc.),[/list]
sonst könnte man dir mit einem entsprechenden Makro helfen.

Du kannst aber auch mal die Profisuche nutzen und bei "Tabellenkalkulation" den Suchbegriff "Dateien zusammen" eingeben. Dann findest du ein paar Beispiele aus früheren Anfragen.

Gruß

M.O.

Answer 2

hallo m.o.,
vielen dank für die rückmeldung...

zu den fragen:
Ja die daten liegen alle in einem verzeichniss,
in jede arbeitsmappe befindet sich nur ein tabellenblatt

auszulesende zelle // in zelle übertragen
a6 // b2
b6 // c2
a7 // d2
b7 // e2
c7 // f2
a8 // g2
c4 // a2
c12 // h2

hoffe das jetzt meine angaben vollständig sind...
danke nochmals...
gruss

Answer 3

Hallo,

kopiere den folgenden Code in ein Standard-Modul deiner Exceldatei, in die die Daten eingelesen werden sollen und speichere die Datei im selben Verzeichnis, wie die Dateien, die geöffnet werden sollen:

Sub einlesen()

Dim DateiName As String
Dim strPfad As String
Dim lngZeile As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

'Pfad für einzulesende Dateien - Datei im selben Pfad speichern wie einzulesende Dateien
strPfad = ThisWorkbook.Path & "\"

'Zähler für einzufügende Zeilen, einzufügen ab Zeile 2
lngZeile = 1

'Dateien öffnen - nur xls-Dateien werden geöffnet
DateiName = Dir(strPfad & "*.xls")

Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=strPfad & DateiName
'Zähler um 1 erhöhen
lngZeile = lngZeile + 1
'Daten übertragen
ThisWorkbook.ActiveSheet.Cells(lngZeile, 1) = Workbooks(DateiName).Worksheets(1).Range("C4") 'Inhalt von C4 in Spalte A übertragen
ThisWorkbook.ActiveSheet.Cells(lngZeile, 2) = Workbooks(DateiName).Worksheets(1).Range("A6") 'A6 in Spalte B übertragen
ThisWorkbook.ActiveSheet.Cells(lngZeile, 3) = Workbooks(DateiName).Worksheets(1).Range("B6") 'B6 in Spalte C übertragen
ThisWorkbook.ActiveSheet.Cells(lngZeile, 4) = Workbooks(DateiName).Worksheets(1).Range("A7") 'A6 in Spalte D übertragen
ThisWorkbook.ActiveSheet.Cells(lngZeile, 5) = Workbooks(DateiName).Worksheets(1).Range("B7") 'B7 in Spalte E übertragen
ThisWorkbook.ActiveSheet.Cells(lngZeile, 6) = Workbooks(DateiName).Worksheets(1).Range("C7") 'C7 in Spalte F übertragen
ThisWorkbook.ActiveSheet.Cells(lngZeile, 7) = Workbooks(DateiName).Worksheets(1).Range("A8") 'A8 in Spalte G übertragen
ThisWorkbook.ActiveSheet.Cells(lngZeile, 8) = Workbooks(DateiName).Worksheets(1).Range("C12") 'C12 in Spalte B übertragen

'geöffnete Dateien wieder schließen, ohne Speicherung
Workbooks(DateiName).Close SaveChanges:=False
End If
DateiName = Dir
Loop

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

Die eingelesenen Datensätze werden ab Zeile 2 in das aktive Blatt geschrieben.

Answer 4

Hallo,

oops, noch den Gruß vergessen ;-(.

Daher:

Gruß

M.O.

Answer 5

hallo m.o....

sory, war gestern nicht mehr online...

funktioniert perfekt.....

ich danke dir sehr....

VIELEN DANK.......

GRUSS

Answer 6

Hallo,

vielen Dank für die Rückmeldung :-).

Gruß

M.O.

Answer 7

hallo m.o.

es war super wie du mir geholfen hast,
dürfte ich nochmals deine hilfe in anspruch nehmen.....

habe folgende problemm:

habe auf einem geöfneten tabellenblatt mit verschiedene infos:
zeilen:
g4
g5
b8
g8
g12
oben aufgeführte zeilen sollen 1:1 in einem anderen datei (z.b. auf d platte in temp order mit der bezechnung: test_1) im hintergrund (nicht sichtbar) nauf die nächste freie zeile geschrieben werden.
weiterhin muss der code auf dem gleichen tabellenblatt in einem bereich (b6:j34) in die b spalte schauen ob etwas drin steht und bei wahr soll er die spalten c und f ebenfals in die gleiche zeile von oben schreiben bis in diesem breich alles ausgelesen ist.

hoffe das ich alle infos aufgeführt habe und du mir nochmals helfen kannst...
habe mich schon für ein kurs in vba angemeldet die aber erst im januar beginnt, bis dahin werde ich eine zeitlang und wahrscheinlich und auch danach auf die hllfe der profis wie du immer wieder bitten....

vielen dank schon im voraus ....
gruss

Answer 8

Hallo,

da diese Frage nichts mit deiner ursprünglichen Frage zu tun hat, solltest du das nächste Mal bitte einen neuen Thread eröffnen.

Dann benutze bitte die richtigen Bezeichnungen, sonst kann es zu Verständnisproblemen kommen (hier Zeile und Zelle) ;-).

habe auf einem geöfneten tabellenblatt mit verschiedene infos:
zeilen:
g4
g5
b8
g8
g12

und

oben aufgeführte zeilen sollen 1:1 in einem anderen datei (z.b. auf d platte in temp order mit der bezechnung: test_1) im hintergrund (nicht sichtbar) nauf die nächste freie zeile geschrieben werden.

Ich nehme mal stark an, dass du jeweils die entsprechenden Zellen und nicht die ganze Zeile meinst, da diese Zellen ja in eine Zeile geschrieben werden sollen (was bei mehreren Zeilen nicht funktioniert).

Verstanden habe, ich dass im Bereich B6 bis B34 geprüft werden soll, ob dort etwas drinsteht (wobei du Zelle B8 ja sowie schon kopierst).
Wenn ich dich richtig verstehe, dann sollen aus den Spalten C und F der entsprechenden Zeile die Werte ebenfalls in die zweite Datei kopiert werden. Wenn also z.B. in B9 etwas steht, sollen die Werte aus C9 und F9 in die entsprechende Zeile der anderen Datei kopiert werden?

Außerdem soll das alles im Hintergrund ausgeführt werden. Soll das Makro per Hand ausgeführt werden oder sollen die Daten z.B. automatisch vor dem Schließen der Datei in die andere Datei übertragen werden?

Gruß

M.O.

Answer 9

hallo m.o.

da sieht man das ich noch sogut wie keine ahnung von der sache habe.... .:-) danke für den hinweis...
natürlich hat du recht mit den "zeilen" und "zellen" , gemeint hatte ich zellen....


bei dem bereichsangaben habe ich ein fehler: berich b16:j34 sollte sein....
mit deinem bespiel hast du auch recht --> wenn in b16 etwas steht, sollen c16 und f16 in die entsprechende Zeile der anderen Datei kopiert werden....

wäre natürlich supper wenn die daten vor dem speichern und schließen der geöffneten datei in den anderen datei automatisch übertragen und abgsichert wird.

ich kann bereits ein makro schreiben der dieses modul aktivieren kann....

ist echt supper wie das hier machen kannst.... bin dir wirklich sehr dankbar.....

gruss

Answer 10

Hallo,

der folgende Code gehört in das VBA der Arbeitsmappe, in der die zu kopierenden Daten stehen:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lngLetzte As Long
Dim strPfad As String
Dim strDatei As String
Dim strTabelle As String
Dim lngZeile As Long
Dim lngZaehler As Long
Dim arrKopieren(25) As Variant
Dim lngSpalte As Long

'Pfad, Dateiname und Name des betreffenden Tabellenblatts der Sicherungsdatei festlegen
strPfad = "C:\Test\"
strDatei = "Sicherung.xlsx"
strTabelle = "Tabelle1"

With Application
.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
.EnableEvents = False 'Ereignisse deaktiven
.Calculation = xlCalculationManual 'Berechnung auf manuell setzen
End With

'feste Daten in ein Array schreiben
arrKopieren(0) = ThisWorkbook.ActiveSheet.Range("G4").Value 'Wert aus G4 nach Spalte A
arrKopieren(1) = ThisWorkbook.ActiveSheet.Range("G5").Value 'G5 nach Spalte B
arrKopieren(2) = ThisWorkbook.ActiveSheet.Range("B8").Value 'G5 nach Spalte C
arrKopieren(3) = ThisWorkbook.ActiveSheet.Range("G8").Value 'G5 nach Spalte D
arrKopieren(4) = ThisWorkbook.ActiveSheet.Range("G12").Value 'G12 nach Spalte B

'Variable für Zähler festlegen
lngZaehler = 3

'nun prüfen, ob im Bereich B16 bis B34 etwas steht und dann ggf. zu vorhandenem Array hinzufügen
With ThisWorkbook.ActiveSheet
For lngZeile = 16 To 34
If .Cells(lngZeile, 2) <> "" Then
lngZaehler = lngZaehler + 2
arrKopieren(lngZaehler) = .Cells(lngZeile, 3).Value 'Wert von Spalte C kopieren
arrKopieren(lngZaehler + 1) = ThisWorkbook.ActiveSheet.Cells(lngZeile, 6).Value 'Wert von Spalte F kopieren
End If
Next lngZeile
End With

'Sicherungsdatei öffnen
Workbooks.Open (strPfad & strDatei)

With Workbooks(strDatei).Worksheets(strTabelle)
'letzte beschriebene Zeile im entsprechenden Tabellenblatt der Sicherungsdatei ermitteln und um 1 erhöhen
lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row + 1

'Daten aus Array in Zeile einfügen
.Range(.Cells(lngLetzte, 1), .Cells(lngLetzte, UBound(arrKopieren))) = arrKopieren

End With

'Sicherungsdatei speichern und schließen
Workbooks(strDatei).Close SaveChanges:=True

'Bildschirmaktualisierung, Ereignisse und automatische Berechnung wieder einschalten
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Die Daten zur Sicherungsdatei (Pfad, Dateiname sowie Name des Tabellenblatts, in das die Daten gesichert werden sollen) musst du natürlich noch anpassen.
Das Makro wird vor dem Schließen deiner Quelldatei ausgeführt.

Und falls du schon mal etwas mehr über VBA wissen willst ;-), dann kannst du z.B. mal hier nachschauen:
KLICK MICH!

Gruß

M.O.