Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1376to1380
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
Inhaltsverzeichnis

Makro um Blätter von versch. Dateien einzubinden

Makro um Blätter von versch. Dateien einzubinden
28.08.2014 12:52:02
versch.
Hey,
ich bräuchte ein Makro, was folgendes kann (Habe da leider nicht mal einen Ansatz für...):
Ich habe sehr viele (ca. 80) gleich aufgebaute Excel-Dateien. Das Makro soll mir jetzt von diesen ganzen Dateien, die Daten im Tabellenblatt "Übersicht" ab einer entsprechenden Zeile (die ist immer gleich) bis zur letzten beschriebenen Zeile untereinander kopieren (nur Werte!).
Ist das überhaupt möglich? Oder muss ich mir etwas anderes einfallen lassen?

23
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro um Blätter von versch. Dateien einzubinden
28.08.2014 13:01:00
versch.
Hallo Andi,
mal ein Ansatz wie Du Daten ohne öffnen der Datei lesen kannst.

For intRow = 1 To 4
Cells(intRow, 5) = ExecuteExcel4Macro("'E:\Test\[test1.xls]Tabelle2'!" & _
Cells(intRow, 2).Address(ReferenceStyle:=xlR1C1))
Next intRow

Schreibt die Einträge aus B1:B4 der angegebenen Datei in E1:E4.
Wenn Du darum noch eine Schleife baust, die dir alle Dateien findet und diese dann als Variable an ExecuteExcel4Macro übergibst, sollte es alles liefern. Beachte aber die eckigen Klammern!!!
Gruß
yummi

AW: Makro um Blätter von versch. Dateien einzub.
28.08.2014 13:12:57
versch.
Könnte ich die Dateien auch über die get.open.filename Funktion auswählen (Mehrfachauswahl)? Der Name der Dateien ist nämlich unterschiedlich.
Oder kann ich das Makro die Aktion für alle im gleichen Ordner befindlichen Dateien ausführen lassen?

Anzeige
AW: Makro um Blätter von versch. Dateien einzub.
28.08.2014 13:13:03
versch.
Könnte ich die Dateien auch über die get.open.filename Funktion auswählen (Mehrfachauswahl)? Der Name der Dateien ist nämlich unterschiedlich.
Oder kann ich das Makro die Aktion für alle im gleichen Ordner befindlichen Dateien ausführen lassen?

AW: Makro um Blätter von versch. Dateien einzub.
28.08.2014 13:13:09
versch.
Könnte ich die Dateien auch über die get.open.filename Funktion auswählen (Mehrfachauswahl)? Der Name der Dateien ist nämlich unterschiedlich.
Oder kann ich das Makro die Aktion für alle im gleichen Ordner befindlichen Dateien ausführen lassen?

Makro um Blätter von versch. Dateien einzubinden
28.08.2014 13:13:36
versch.
Könnte ich die Dateien auch über die get.open.filename Funktion auswählen (Mehrfachauswahl)? Der Name der Dateien ist nämlich unterschiedlich.
Oder kann ich das Makro die Aktion für alle im gleichen Ordner befindlichen Dateien ausführen lassen?

Anzeige
Ansatz
28.08.2014 13:14:16
Andi
Könnte ich die Dateien auch über die get.open.filename Funktion auswählen (Mehrfachauswahl)? Der Name der Dateien ist nämlich unterschiedlich.
Oder kann ich das Makro die Aktion für alle im gleichen Ordner befindlichen Dateien ausführen lassen?

Ansatz
28.08.2014 13:14:17
Andi
Könnte ich die Dateien auch über die get.open.filename Funktion auswählen (Mehrfachauswahl)? Der Name der Dateien ist nämlich unterschiedlich.
Oder kann ich das Makro die Aktion für alle im gleichen Ordner befindlichen Dateien ausführen lassen?

AW: Ansatz
28.08.2014 14:36:25
fcs
Hallo Andi,
hier das Gerüst für ein entsprechendes Makro.
Gruß
Franz
Sub DatenZusammensuchen()
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, varQuelle As Variant
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim Zeile_Z As Long, Zeile_Q As Long, Zeile_Q1 As Long
Dim Zelle As Range, rngCopy As Range
On Error GoTo Fehler
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Worksheets("Tabelle1")
With wksZiel
'1. Einfügezeile in Ziel-abelle ermitteln
Set Zelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Zelle Is Nothing Then
Zeile_Z = 1
Else
Zeile_Z = Zelle.Row + 1
End If
End With
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte die Datei mit den Quelldaten auswählen (Mehrfach-Auswahl ist möglich)"
.AllowMultiSelect = True
Application.ScreenUpdating = False
If .Show = -1 Then
For Each varQuelle In .SelectedItems
Set wkbQuelle = Application.Workbooks.Open(varQuelle, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Worksheets("Übersicht")       ' - ggf. anpassen
Zeile_Q1 = 3 '1. zu kopierende Zeile in Quellblättern   - ggf. anpassen
With wksQuelle
Set Zelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Zelle Is Nothing Then
'keine Daten im Tabellenblatt - leeres Blatt
ElseIf Zelle.Row 

Anzeige
AW: Ansatz
28.08.2014 15:11:21
Andi
Der Wahnsinn!!! Schon mal vielen herzlichen Dank.
Mir ist allerdings gerade aufgefallen, dass ich in der letzten Zeile der Quelldatei immer die Summe angebe. Wo im Code kann ich das verändern, dass er die letzte Zeile nicht mit kopiert?
PS: Ich weiß nicht genau wie man Beiträge löschen kann. Irgendwie habe ich den vorherigen Beitrag gefühlt 100 mal erstelle -.-

AW: Ansatz
28.08.2014 15:39:41
fcs
Hallo Andi,
ändere die Zeile
              Zeile_Q = Zelle.Row

in
              Zeile_Q = Zelle.Row -1
Beiträge kannst du nicht löschen.
Meines Wissens vermeidest du die Mehrfacheinträge wenn du nach dem Absenden der Frage/Antwort in dem Angezeigten Fenster "Speicherbestätihgung" rechts unten den Link "Zurück zur Forumsliste" anklickst.
Auf keinen Fall die Browserfunktion "Seite zurück" nutzen!
Gruß
Franz

Anzeige
AW: Ansatz
29.08.2014 09:42:35
Andi
Super, Danke! Funktioniert!
Ein Problem habe ich noch:
In den Tabellen, die kopiert werden sollen, ist unter der Summenzeile eine Formel, die den Wert "" ausgibt. Das Makro kopiert jetzt aber alle Zeilen, die diese Formel enthalten ebenfalls!
Könnte man einbauen, dass nur Zellen "" kopiert werden oder irgendwie so?

AW: Ansatz
29.08.2014 10:56:39
fcs
Hallo Andi,
das Makro sucht in der jetzigen Form schon nach der letzten Zelle/Zeile mit einem Wert &lt&gt"".
Unterhalb der Zeile mit der Summenformel müssen noch Zellen mit Werten (z.B. Leerzeichen) vorhanden sein.
Gruß
Franz

Anzeige
AW: Ansatz
29.08.2014 13:41:41
Andi
Hallo Franz,
ich habe es nochmal kontrolliert. Das ganze funktioniert nur, wenn ich die Formeln lösche! Wenn ich sie drin lasse (und sie geben definitiv alle "" aus) dann kopiert mir das Skript alle Zellen, die diese Formel enthalten.

AW: Ansatz
29.08.2014 14:51:14
fcs
Halo Andi,
ich hab es jetzt nochmals intensiv getestet und es funktioniert definitiv.
Meine Testformel für die Summenspalte F:
=WENN(A99="Summe";SUMME($F$3:F98);WENN(ANZAHL2(A99:E99)=0;"";SUMME(B99:E99)))

Die Formeln gehen bis Zeile 104, in Zelle A98 steht "Summe" und das Makro kopiert korrekt die Zeilen bis Zeile 97.
Aus meiner Sicht müssen da bei dir irgendwo unterhalb der Angezeigten Summenzeile mit Werte in anderen Zellen noch Werte stehen.
Gruß
Franz

Anzeige
AW: Ansatz
01.09.2014 08:29:52
Andi
Ich habe hier jetzt mal das Excelblatt hochgeladen. Wahrscheinlich ist es offensichtlich, aber ich finde den Fehler irgendwie nicht.
https://www.herber.de/bbs/user/92418.xlsm

AW: Ansatz
01.09.2014 09:54:07
yummi
Hallo Andi,
ohne eine Importdatei wird es schwierig nachzustellen ;-)
Gruß
yummi

AW: Ansatz
01.09.2014 10:55:20
Andi
Verstehe ich nicht so ganz. Es ist für mich lediglich relevant, ob die hochgeladenen Datei überall ="" ausgibt. Anscheinend nicht, sonst würde die Formel funktionieren... ich weiß allerdings nicht wo sie etwas anderes ausgibt!

Anzeige
AW: Ansatz
01.09.2014 11:18:10
yummi
Hallo Andi,
ich habe in F7 -H7 ein "-" stehen und in den rstlichen Feldern der zeile 7 #Bezug
Gruß
yummi

AW: Ansatz
01.09.2014 12:17:52
Andi
OK. Neuer Ansatz:
Wie muss ich denn den Code ändern, damit er nur in einer bestimmten Spalte die nächste leere Zelle sucht?

AW: Ansatz
01.09.2014 14:50:35
fcs
Hallo Andi,
es schein die Formatierung der Zellen zu sein, warum mein Makro in deiner Datei die Zellen mit Ergebnis "" als mit Daten gefüllt erkennt. Zetze ich das Zahlenformat auf Standerd, dann geht es.
Um jetzt mit dem vorhandenen Format die Letzte Zeile mit Ergebnis ungleich "" in einer Spalte zu ermittel kannst du die folgende Function benutzen.
Gruß
Franz
Sub bbTest()
Dim Zeile_Q As Long, Zeile_Q1 As Long, rngCopy As Range
Dim wkbQuelle As Workbook, wksQuelle As Worksheet
Set wkbQuelle = ActiveWorkbook
Set wksQuelle = wkbQuelle.Worksheets("Übersicht")
With wksQuelle
Zeile_Q1 = 3
'Letzte Zeile verschieden von "" in Spalte F
Zeile_Q = fncLetzteVerschieden_von_Leer(wks:=wksQuelle, Spalte:=6)
If Zeile_Q = 0 Then
MsgBox "'keine Daten im Tabellenblatt - leeres Blatt"
ElseIf Zeile_Q  "" Then
fncLetzteVerschieden_von_Leer = lngZeile
Exit For
End If
Next
End With
End Function

Anzeige
AW: Ansatz
01.09.2014 15:33:38
Andi
Danke, ich war schon am verzweifeln.
Jetzt noch eine Frage:
Wie binde ich deinen Code nun in den vorhandenen (das Gerüst welches du gepostet hast) ein. Bei meinem Versuch kommt: "Fehler-Nr.:13, Typen unverträglich".

AW: Ansatz
02.09.2014 07:29:18
Andi

Sub Betriebsbögen_importieren()
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, varQuelle As Variant
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim Zeile_Z As Long, Zeile_Q As Long, Zeile_Q1 As Long
Dim Zelle As Range, rngCopy As Range
On Error GoTo Fehler
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Worksheets("Gesamtübersicht")
With wksZiel
'1. Einfügezeile in Ziel-abelle ermitteln
Set Zelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Zelle Is Nothing Then
Zeile_Z = 1
Else
Zeile_Z = Zelle.Row + 1
End If
End With
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte die Datei mit den Quelldaten auswählen (Mehrfach-Auswahl ist möglich)"
.AllowMultiSelect = True
Application.ScreenUpdating = False
If .Show = -1 Then
For Each varQuelle In .SelectedItems
Set wkbQuelle = Application.Workbooks.Open(varQuelle, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Worksheets("Übersicht")
With wksQuelle
Zeile_Q1 = 7
'Letzte Zeile verschieden von "" in Spalte F
Zeile_Q = fncLetzteVerschieden_von_Leer(wks:=wksQuelle, Spalte:=6)
If Zeile_Q = 0 Then
MsgBox "'keine Daten im Tabellenblatt - leeres Blatt"
ElseIf Zeile_Q  "" Then
fncLetzteVerschieden_von_Leer = lngZeile
Exit For
End If
Next
End With
End Function
So funktioniert es irgendwie nicht...

Anzeige
AW: Ansatz
02.09.2014 11:36:58
fcs
Hallo Andi,
was funktioniert denn "irgendwie" nicht?
Ich hab deine Variante jetzt mal mit deiner Beispiel-Übersichtsdatei getestet und da werden die Zeilen scheinbar korrekt importiert.
Gruß
Franz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige