8
Excel 2003 Automatisches Übertragen von Daten versch. Exceldateien auf eine Exceldatei
Ich versuche mich schon ewig daran mein Problem zu lösen. Ich habe hier ein Beitrag gefunden, der fast mein Problem trifft, aber ich schaff es nicht den Code so umzuändern, dass er auf mein Problem passt.
Link: https://www.administrator.de/forum/excel-makro-daten-aus-mehreren-tabell ...
Hallo,
ich hoffe ich kann mein Problem verständlich erkären.
Ich habe verschiedene Excel Sheets (in einem Ordner) mit denen Kalkulationen durchgeführt werden. Jedes dieser Sheets hat eine Übersichtsseite (Deckblatt), auf der die errechneten Kennzahlen/Summen aber auch Text steht ( E38 bis G57 und ich habe keine Rechte das Dokument zu ändern).
Jetzt sollen die Datenblöcke nebereinander angeordnet werden, damit es schön übersichtlich ist.
Wie schon gesagt, eigentlich ist der oben genannte Link schon die Lösung, aber ich schaff es einfach nicht ihn auf mein Problem zu übertragen.
Ich hoffe ihr könnt mir weiter helfen.
Vielen Dank im Voraus.
lg paterpen
ich hoffe ich kann mein Problem verständlich erkären.
Ich habe verschiedene Excel Sheets (in einem Ordner) mit denen Kalkulationen durchgeführt werden. Jedes dieser Sheets hat eine Übersichtsseite (Deckblatt), auf der die errechneten Kennzahlen/Summen aber auch Text steht ( E38 bis G57 und ich habe keine Rechte das Dokument zu ändern).
Jetzt sollen die Datenblöcke nebereinander angeordnet werden, damit es schön übersichtlich ist.
Wie schon gesagt, eigentlich ist der oben genannte Link schon die Lösung, aber ich schaff es einfach nicht ihn auf mein Problem zu übertragen.
Ich hoffe ihr könnt mir weiter helfen.
Vielen Dank im Voraus.
lg paterpen
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 193129
Url: https://administrator.de/contentid/193129
Printed on: April 19, 2024 at 07:04 o'clock
8 Comments
Latest comment
hallo paterpen,
bitte beschreib doch mal genau, worin dein Problem besteht.
Kommt eine Fehlermeldung beim Ausführen des Makros?
Wird in der Zieldatei nichts eingetragen?
liebe Grüße, drnatur
bitte beschreib doch mal genau, worin dein Problem besteht.
Kommt eine Fehlermeldung beim Ausführen des Makros?
Wird in der Zieldatei nichts eingetragen?
liebe Grüße, drnatur
Hallo paterpen und willkommen im Forum!
Vielleicht geht es ja so besser:
Alternativ zur Angabe des Blattnamens (Variable QT) kannst Du (wie im verlinkten Beitrag) in Zeile 20 auch einfach 1 (für erstes Blatt der Mappe) verwenden ...
Grüße
bastla
Vielleicht geht es ja so besser:
Sub Zusammenfassen()
sQuellpfad = "D:\Test"
QT = "Deckblatt" 'Tabellenname in der Quelldatei
Q = "E38:G57" 'Quellbereich
ZAbSpalte = 1 'ab dieser Spalte Daten in Sammeldatei schreiben
ZZeile = 3 'ab dieser Zeile Daten in Sammeldatei schreiben
Set wbGes = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
QSpalten = Range(Q).Columns.Count 'Spaltenanzahl des Quellbereichs ermitteln
QZeilen = Range(Q).Rows.Count 'Zeilenanzahl des Quellbereichst ermitteln
ZSpalte = ZAbSpalte 'Spaltennummer vorbelegen
For Each oFile In fso.GetFolder(sQuellpfad).Files
If LCase(fso.GetExtensionName(oFile.Name)) = "xlsx" Then
Application.Workbooks.Open oFile.Path
wbGes.Worksheets(1).Cells(ZZeile, ZSpalte).Value = fso.GetBaseName(ActiveWorkbook.Name) 'Dateinamen der Quelldatei eintragen
wbGes.Worksheets(1).Cells(ZZeile + 1, ZSpalte).Resize(QZeilen, QSpalten).Value = ActiveWorkbook.Worksheets(QT).Range(Q).Value 'Werte aus Quelldatei übernehmen
ActiveWorkbook.Close False
ZSpalte = ZSpalte + QSpalten 'Spaltennummer der Zieldatei für nächsten Block erhöhen
End If
Next
wbGes.Worksheets(1).Activate
wbGes.Save
MsgBox "Fertig."
End SubGrüße
bastla
Ersteinmal vielen Dank für die schnelle Antwort. Ich hatte es garnicht erwartet so schnell eine Antwort zu bekommen. Ich war leider gestern den ganzen Tag verhindert, sodass ich erst heute antworten kann.
Das Makro funktioniert! Nach 1h tüfteln hab ich heraus gefunden, dass ich in Zeile 17 statt "xlsx", "xls" eingeben muss. So simple...
Vielen vielen Dank. Wenn ich überlegt, wie lange ich an dem Makro saß (ca 25h) und Bastla mir innerhalb von 2h die Lösung gibt :D Respekt.
Meine Frage ist damit beantwortet, aber ich hätte noch zwei Folgefragen:
1. Ich habe jetzt meine Excel erweitert um ein Objekt, das bei Bestätigung das Makro ausführt + Format der kopierten Daten anpasst. Aber ich weiß nicht, wie ich das Format auf nur die kopierten Tabellen/Daten bezieh?
Meine Idee (keine schöne Lösung) wäre es das Format auf einen riesigen Bereich zu übertragen per Makro, aber jetzt müsste ich Spalten ausblenden lassen in Abhängigkeit von den Dateien die ich einlese, damit es schöner aussieht.
ungefähr so:
b = 200
Worksheets("Tabelle1").Columns(Zspalte & ":" & b).Select
Selection.EntireRow.Hidden = True
2. Das Marko gibt ja automatisch den Namen der jeweiligen Datei aus. Kann ich gleichzeitig auch noch den Hyperlink dazufügen lassen???
Vielen Dank im Voraus
lg paterpen
Das Makro funktioniert! Nach 1h tüfteln hab ich heraus gefunden, dass ich in Zeile 17 statt "xlsx", "xls" eingeben muss. So simple...
Vielen vielen Dank. Wenn ich überlegt, wie lange ich an dem Makro saß (ca 25h) und Bastla mir innerhalb von 2h die Lösung gibt :D Respekt.
Meine Frage ist damit beantwortet, aber ich hätte noch zwei Folgefragen:
1. Ich habe jetzt meine Excel erweitert um ein Objekt, das bei Bestätigung das Makro ausführt + Format der kopierten Daten anpasst. Aber ich weiß nicht, wie ich das Format auf nur die kopierten Tabellen/Daten bezieh?
Meine Idee (keine schöne Lösung) wäre es das Format auf einen riesigen Bereich zu übertragen per Makro, aber jetzt müsste ich Spalten ausblenden lassen in Abhängigkeit von den Dateien die ich einlese, damit es schöner aussieht.
ungefähr so:
b = 200
Worksheets("Tabelle1").Columns(Zspalte & ":" & b).Select
Selection.EntireRow.Hidden = True
2. Das Marko gibt ja automatisch den Namen der jeweiligen Datei aus. Kann ich gleichzeitig auch noch den Hyperlink dazufügen lassen???
Vielen Dank im Voraus
lg paterpen
Schade, dass mir keiner mehr antwortet. Ist meine Frage quasi geschlossen, da ich die Lösung habe??????
Ich würde gern noch wissen, ob ich auch gleichzeitig mit den Werten das Format übertragen kann.
Lg
Paterpen
Ich würde gern noch wissen, ob ich auch gleichzeitig mit den Werten das Format übertragen kann.
Lg
Paterpen
Hallo paterpen!
Jeweils E38:G57 zu kopieren, sollte etwa so gehen:
Grüße
bastla
Jeweils E38:G57 zu kopieren, sollte etwa so gehen:
Sub Zusammenfassen()
sQuellpfad = "D:\Test"
QT = "Deckblatt" 'Tabellenname in der Quelldatei
Q = "E38:G57" 'Quellbereich
ZAbSpalte = 1 'ab dieser Spalte Daten in Sammeldatei schreiben
ZZeile = 3 'ab dieser Zeile Daten in Sammeldatei schreiben
Set wbGes = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
QSpalten = Range(Q).Columns.Count 'Spaltenanzahl des Quellbereichs ermitteln
QZeilen = Range(Q).Rows.Count 'Zeilenanzahl des Quellbereichst ermitteln
ZSpalte = ZAbSpalte 'Spaltennummer vorbelegen
For Each oFile In fso.GetFolder(sQuellpfad).Files
If LCase(fso.GetExtensionName(oFile.Name)) = "xlsx" Then
Application.Workbooks.Open oFile.Path
wbGes.Worksheets(1).Cells(ZZeile, ZSpalte).Value = fso.GetBaseName(ActiveWorkbook.Name) 'Dateinamen der Quelldatei eintragen
ActiveWorkbook.Worksheets(QT).Range(Q).Copy wbGes.Worksheets(1).Cells(ZZeile + 1, ZSpalte)'Zellen aus Quelldatei kopieren
ActiveWorkbook.Close False
ZSpalte = ZSpalte + QSpalten 'Spaltennummer der Zieldatei für nächsten Block erhöhen
End If
Next
wbGes.Worksheets(1).Activate
wbGes.Save
MsgBox "Fertig."
End Subbastla
Hallo Bastla,
erstmal danke für die Antwort. Ich habe es doch hinbekommen, aber ein bisschen anders. Wobei eigentlich ist es des gleiche^^
ab Zeile 20:
ActiveWorkbook.Worksheets(QT).Range(Q).Copy
wbGes.Worksheets(1).Cells(ZZeile + 1, Zspalte).Resize(QZeilen, QSpalten).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
und zu meiner anderen Frage (Spalten ausblenden, wenn sie leer sind), ist das hier die Lösung:
Dim rngZelle As Range
For Each rngZelle In Range("E20:IG20")
rngZelle.EntireColumn.Hidden = rngZelle = ""
Next rngZelle
- Hättest du auch eine Lösung zu dem Hyperlink Problem?
d.h. dem Dateinamen automatisch auch den Hyperlink zuweisen.
Vielen Dank im Voraus
Lg Paterpen
erstmal danke für die Antwort. Ich habe es doch hinbekommen, aber ein bisschen anders. Wobei eigentlich ist es des gleiche^^
ab Zeile 20:
ActiveWorkbook.Worksheets(QT).Range(Q).Copy
wbGes.Worksheets(1).Cells(ZZeile + 1, Zspalte).Resize(QZeilen, QSpalten).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
und zu meiner anderen Frage (Spalten ausblenden, wenn sie leer sind), ist das hier die Lösung:
Dim rngZelle As Range
For Each rngZelle In Range("E20:IG20")
rngZelle.EntireColumn.Hidden = rngZelle = ""
Next rngZelle
- Hättest du auch eine Lösung zu dem Hyperlink Problem?
d.h. dem Dateinamen automatisch auch den Hyperlink zuweisen.
Vielen Dank im Voraus
Lg Paterpen
Hallo paterpen!
Schon mal versucht, den entsprechenden Code über das Aufzeichnen eines Makros zu finden (abgesehen davon, dass mit dem Stichwort "Hyperlink" auch die Online-Hilfe Brauchbares liefern sollte)?
Grundsätzlich könnte das dann etwa so aussehen:
Grüße
bastla
Schon mal versucht, den entsprechenden Code über das Aufzeichnen eines Makros zu finden (abgesehen davon, dass mit dem Stichwort "Hyperlink" auch die Online-Hilfe Brauchbares liefern sollte)?
Grundsätzlich könnte das dann etwa so aussehen:
wbGes.Worksheets(1).Hyperlinks.Add wbGes.Worksheets(1).Cells(ZZeile, ZSpalte), oFile.Path, , ,fso.GetBaseName(ActiveWorkbook.Name)bastla
Hallo bastla,
vielen Dank erstmal. Das Makro funktioniert super. Es ist mittlerweile ziemlich kompliziert, da noch mehr Sachen dazu gekommen sind, die ich hier nicht gefragt habe :D
Ich versuch immer als erstes über Aufzeichnen alles zu lösen bzw. so die Befehle heraus zu finden. Dann such ich im Internet nach Lösungen und versuch diese auf mein Problem zu übertragen. Und dann poste ich erst hier :D
Meistens fehlt mir nur der richtige Befehl bzw. ich habe kleine Fehler.
Beim Aufzeichnen ist auch immer das Problem, dass ich so eine Lösung hinbekomme, diese aber nicht für anderen Dateien/Anwendungen übertragbar sind und ich dann das Makro erstmal "verallgemeinern" muss.
Naja...
Nochmal vielen Dank für die gute Unterstützung.
lg
paterpen
vielen Dank erstmal. Das Makro funktioniert super. Es ist mittlerweile ziemlich kompliziert, da noch mehr Sachen dazu gekommen sind, die ich hier nicht gefragt habe :D
Ich versuch immer als erstes über Aufzeichnen alles zu lösen bzw. so die Befehle heraus zu finden. Dann such ich im Internet nach Lösungen und versuch diese auf mein Problem zu übertragen. Und dann poste ich erst hier :D
Meistens fehlt mir nur der richtige Befehl bzw. ich habe kleine Fehler.
Beim Aufzeichnen ist auch immer das Problem, dass ich so eine Lösung hinbekomme, diese aber nicht für anderen Dateien/Anwendungen übertragbar sind und ich dann das Makro erstmal "verallgemeinern" muss.
Naja...
Nochmal vielen Dank für die gute Unterstützung.
lg
paterpen
