Hallo Zusammen,
ich habe folgendes Problem
:
ich muss aus 2000+ seperaten Arbeitsblättern Daten in eine Tabelle zusammenführen. Ich kenne mich zwar mit Excel aus, aber da benötige ich die Hilfe der Community.
Ich hänge mal ein Arbeitsblatt an.
Vielen Dank für eure Hilfe im Voraus. :28:
Eike
Hallo,
es wird zwar etwas dauern, aber VBA kann auch 2000+ Tabellen nacheinander öffnen, auslesen und in einer neuen Tabelle zusammenfassen.
Um einen Code zu entwickeln sind einige Angaben notwendig:
- alle Dateinen in einem Ordner? Namenskonventionen
- welche Daten sollen selektiert werden? (im Beispiel ist das nict zu erkennen)
Versuche dich in jemanden hineinzuversetzen, der VBA kennt, aber nicht deine Aufgabenstellung und liefere alle notwendigen Infos.
mfg
Moin,
neben Fenneks berechtigten Anmerkungen noch dieses von mir:
- Der Aufbau der Tabelle ist unprofessionell (aus Excel-Sicht), beachte den Leitsatz: "Form follows function"
- Du wirst mit den verbundenen Zellen noch viel "Freude" haben
- Sollen die Daten aggregiert werden?
Hallo Fennek, Hallo GMG-CC,
ja, die Tabelle ist leider von einem Nicht-Excel-Mensch aufgebaut worden. Das ist so auch erstmal nicht mehr zu ändern.
@Fennek: Alle Dateien können in einen Ordner gepackt werden. Soweit war ich auch und ich hatte auch einen VBA Code zu zusammenführen. Der streikt nur, weil alle Arbeitsblätter den gleichen Titel haben "Produktinformation zur Rüstvorbereitung". Nach zwei zusammengeführten Blättter hat der Code einen Fehler gemeldet.
Es sollen alle Daten selektiert werden. Bedeutet, Spaltenüberschriften sollen die Überschriften sein(z.B. Handling, Anguß, etc.) Darunter sollen die Daten aus jedem einzelnen Arbeitsblatt geschrieben werden.
Gruß
Hallo,
es ist eine langweilige Fleißarbeit: nichts für mich.
Ein paar Tipps:
Die Schleife über alle Dateien:
Code:
Sub Einlesen()
iPath = "c:\temp\" '<<<<< anpassen
iFile = dir (ipath & " *.xls*")
do while len(iFile)
'############ hier der Code zum Einlesen
iFile = dir
loop
end sub
Ungeprüft:
In der Ergebnisdatei (die mit dem Makro) in der ersten Zeile die Überschriften:
Datei
Artikel
Art-Nr
L.Nummer
Fachzahl
Maschine
Zyklus
Gewicht
Entformung
Heißkanal
Regelstellen
Anguß
Verarbeiten
Düse
Material
Rezeptur
EW-Nr
Besonderheiten
Packart
Auto. Packbild
Handling
Kernzug
Auswerferlänge
Angussentfomung
Zubehör Kästen
Zentrierung
Schrauben
Förderband
Adapterplatten
Materialtonne
Laschen
Prüfmuster
Alle Felder einlesen
Code:
'Einlesen
with workbooks.open(iPath & iFile)
lr = thisworkbook.sheets(1).cells(rows.count, "A").end(xlup).row + 1
cells(lr,"A") = iFile
cells(lr, "B") = .cells(4,"A") 'Artikel
cells(lr,"C") = .cells(9,"A") 'Artikel-Nr
usw
.close 0
end with
Auf die Schnelle fand ich keine einfache Formel für die Zuordnung, da es manchmal 3, manchmal 4 Werte pro Zeile gibt.
Wenn du den Code kompletiert hast, lade ihn hoch.
mfg
Hi Fennek,
habe den Code zusammengebastelt:
Code:
Sub Einlesen()
iPath = "Y:\Projekte\Laufende\MAsterworkbook Rüstvorbereitung\Workbooks\"
iFile = Dir(iPath & "*.xls*")
Do While Len(iFile)
With Workbooks.Open(iPath & iFile)
lr = ThisWorkbook.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(lr, "A") = iFile
Cells(lr, "B") = Cells(4, "A") 'Artikel
Cells(lr, "C") = Cells(9, "A") 'Artikel-Nr
Close 0
End With
iFile = Dir
Loop
End Sub
Der öffnet aber nur alle Arbeitzsblätter separat. SOnst macht der nix.
Hab ich was falsch gemacht? Bin VBA Anfänger
Hi,
der Code kann ja auch nichts anderes machen, keiner sagt ihm, was er tun soll.
Nach dem Öffnen der Arbeitsblätter solltest Du Excel also sagen, welche Bereiche kopiert werden sollen und dann einfügen:
- Datei öffnen
- Letzte belegte Zeile Quelle feststellen
- Erste freie Zeile Ziel feststellen (= letzte belegte + 1)
- Kopieren von erster Zeile Quelle bis letzte Zeile Quelle
- Einfügen in erste freie Zeile Ziel
nächste Datei
Hallo,
das ist ein ziemliches Missverständnis. Es fehlen die anderen Variablen und diverse Punkte:
Code:
Sub Einlesen()
iPath = "Y:\Projekte\Laufende\MAsterworkbook Rüstvorbereitung\Workbooks\"
iFile = Dir(iPath & "*.xls*")
Do While Len(iFile)
With Workbooks.Open(iPath & iFile)
lr = ThisWorkbook.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(lr, "A") = iFile
Cells(lr, "B") = .Cells(4, "A") 'Artikel
Cells(lr, "C") = .Cells(9, "A") 'Artikel-Nr
######## hier für jede Spalte eine Zeile einfügen ######
Close 0
End With
iFile = Dir
Loop
End Sub
Das Tippen musst du schon selbst machen!
mfg
Hallo,
sieh mal, ob diese Umsetzung passt: