Supportnet / Forum / Tabellenkalkulation

Hallo Leute, vielleicht gibt es für mein Problem eine Lösung. Ich komme leider nicht weiter. Hier mein Problem: Ich habe in einem Verzeichnis ca. 250 Dateien. Diese Dateien werden von Kollegen gepflegt. Ich muß nun überprüfen, ob die Kollegen ihre Aufgaben erfüllen. Jetzt will ich natürlich nicht alle 250 Dateien einzeln öffnen und mir manuell die 7 Felder anschauen, ob die Kollegen die Daten aktualisiert haben. Ich möchte also eine Übersicht erstellen, die mir diese 7 Felder nebeneinander aufzeigt. Ich habe allerdings keine Lust/Zeit, die Formeln für die ganze externen Verknüpfungen auf jede dieser ca. 250 Dateinamen zu ändern. Denn leider habe ich 5 Verzeichnisse in dieser Größe. Gibt es da automatische Abhilfe? Wird die Übersicht vom Dateivolumen zu groß werden? Danke für die Hilfe. Gruß Robert

Hallo Robert,

folgender Code fragt zuerst mit einer Inputbox den Pfad ab. Anschließend werden alle Excelmappen die in diesem Pfad gefunden werden nacheinander geöffnet, der Bereich A1:G1 in die Mappe "Test" untereinander kopiert und die Mappen wieder geschlossen.

Option Explicit

Sub Dateien_kopieren()
Application.ScreenUpdating = False
Dim zähler As Long, Pfad As String
Pfad = InputBox("Verzeichnis:", "Welches Verzeichnis?", Default:= _
"C:\Dokumente und Einstellungen\user\Desktop\Test")
If Pfad = "" Then Exit Sub
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Pfad
.SearchSubFolders = True
If .Execute <> 0 Then
For zähler = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
ActiveWorkbook.Sheets("Tabelle1").Range("A1:G1").Copy _
Destination:=Workbooks("Test").Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ActiveWorkbook.Close
Next zähler
End If
End With
Application.ScreenUpdating = True
End Sub

Gruß

JöKe

Hallo JöKe,
danke für die prompte Antwort.
Habe es auch gleich heute morgen ausprobiert. Leider heißen aber die einzelnen Tabellenblätter nicht Tabelle1, sondern alle unterschiedlich. Beinhaltet immer die Kundennummer und die ersten Zeichen des Kundennamen. Dies sind dann sozusagen ein Teil des Dateinamen.
Z. Bsp. heißt die Datei "123456_Köln Direkt" und das Tabellenblatt, wo die Daten stehen, heißt "123456_Köln ".
Inzwischen habe ich es auch mal mit einigen Dateien geprüft, bei denen ich das Tabellenblatt auf "Tabelle1" geändert habe. Aber auch da klappt es nicht. Gibt einen Laufzeitfehler "9" zurück. Index liegt ausserhalb des gültigen Bereich.
Habe ich etwas falsch gemacht?
Gruß
Robert

Hallo Robert,

eigentlich sollte der Code funktionieren, wenn du

die Blattnamen auf "Tabelle1" geändert hast
du den Namen der Zieldatei im Code geändert hast (hier "Test")

welche Zeile im Code wird gelb hinterlegt, wenn der Laufzeitfehler kommt?
Wieviel genutzte Blätter befinden sich in den Dateien?
Sind die original Blattnamen bzw. Dateinamen immer gleich lang?


Gruß

JöKe

Hallo JöKe,
die Zeilen von "ActiveWookbook.Sheets ..." bis "... Offset(1, 0)" sind gelb hinterlegt. Die erste Datei wird auch immer geöffnet.
Testweise habe ich 6 Dateien angelegt, die unterschiedliche Zahlen in den Feldern A1 bis G1 haben. Diese Dateien haben die Namen "1", "2", usw. Die Datei, die das Makro enthält, hat den Namen "Test" und überall heissen die Tabellenblätter "Tabelle1". Trotzdem kommt der Laufzeitfehler.
In den Blättern ist nur das eine Tabellenblatt benutzt.
Die Blatt- und Dateinamen haben unterschiedliche Längen in den Originalen.
Danke weiterhin.
Gruß
Robert

Hallo Robert,

versuch es mal hiermit:

Option Explicit

Sub Dateien_kopieren()
Application.ScreenUpdating = False
Dim zähler As Long, Pfad As String
Pfad = InputBox("Verzeichnis:", "Welches Verzeichnis?", Default:= _
"C:\Dokumente und Einstellungen\user\Desktop\Test")
If Pfad = "" Then Exit Sub
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Pfad
.SearchSubFolders = True
If .Execute <> 0 Then
For zähler = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
ActiveWorkbook.Sheets(1).Range("A1:G1").Copy _
Destination:=Workbooks("Test").Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ActiveWorkbook.Close
Next zähler
End If
End With
Application.ScreenUpdating = True
End Sub

Entferne mal zur Sicherheit alle ungenutzten Blätter aus den Testdateien, so das nur noch das Blatt welches die Daten enthält vorhanden ist.

Gruß

JöKe

Hallo JöKe,
klappt leider auch nicht. Gibt die gleiche Fehlermeldung an der gleichen Stelle.
Gruß
Robert

Hallo Robert,

leider komm ich dann auch nicht weiter.

Zum Testen habe ich auf dem Desktop einen Ordner "Test" (der wird in der Abfrage auch als Vorschlag angegeben.)
In diesem Ordner habe ich 5 Mappen mit unterschiedlcihen Namen. In jeder Mappe habe ich jeweils 1 Tabellenblatt mit einem willkürlichen Namen. Die Zieldatei "Test" liegt ebenfalls auf dem Desktop. Wenn ich nun aus der Zieldatei heraus das Makro starte, kopiert er mir jeweils den Bereich A1:G1 in die Zieldatei.
Ansich ist es unwichtig wie die Ordner, die Mappen oder die Blätter heißen. Das einzige was korrekt angegeben werden muss ist das Verzeichnis in dem die Mappen sich befinden.

Index liegt ausserhalb des gültigen Bereich

deutet daraufhin, dass evetuell irgendwo ein Schreibfehler aufgetretten ist. Überprüf doch nochmal bitte die einzelnen Bezeichnungen.

Gruß

JöKe

Hi All,

hier ein überarbeiteter Vorschlag von mir. Mein Eindruck war, daß Excel, wenn eine neue Datei geöfnet und Werte abgefragt werden, diese dann als aktives Workbook annimmt, und daher Probleme hat, Destination für den entsprechendesn Pastebefehl in einem nichtaktiven Workboock zu finden.
Daher bei mir extra Aktivierung.

Option Explicit

Sub Dateien_kopieren()
Application.ScreenUpdating = False
Dim zähler As Long, Pfad As String, Nam As String, N As String, a As Integer, b As Integer
REM Pfad = InputBox("Verzeichnis:", "Welches Verzeichnis?", Default:= _
"C:\Dokumente und Einstellungen\user\Desktop\Test")
Pfad = ActiveWorkbook.Path
Nam = Pfad & "\Test.xls"
If Pfad = "" Then Exit Sub
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Pfad
.SearchSubFolders = True
If .Execute <> 0 Then
For zähler = 1 To .FoundFiles.Count
 If .FoundFiles(zähler) <> Nam Then
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
a = Len(Pfad)
b = Len(.FoundFiles(zähler))
N = Mid(.FoundFiles(zähler), a + 2, b - a)
ActiveWorkbook.Sheets(1).Range("A1:G1").Copy
Workbooks("Test.xls").Activate
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Value = N
Workbooks(N).Close
Else: End If
Next zähler
End If
End With
Application.ScreenUpdating = True
End Sub

Diesen Code einfügen in ein Excel-Workbook mit dem Namen Test.xls. Ich hab´s insofern vereinfacht, daß die Pfad-Abfrage entfällt, dafür muß aber Test.xls in dem selben Ordner stehen wie die abzufragenden Dateien. Es werden aus allen Dateien der Bereich A1:G1 des ersten Tabellenblattes abgefragt und in Test.xls in das jeweils aktive Blatt untereinander eingetragen. Zur Besseren Übersicht noch den zugehörigenTabellen-Namen in H1 - Hx.

Gruß

Primut

Hallo JöKe,
als ich in Deinem Makro den Workbook von "text" auf "test.xls" geändert habe, hat es geklappt. Zumindest bei den Dateien, bei denen das Tabellenblatt mit "Tabelle1" bezeichnet war.
Hallo Primut,
Dein Makro funktioniert. Es ist auch egal, wie die Tabellenblätter heissen. Allerdings klappt es nur, bis er zu der Datei "text.xls" kommt, die ja im gleichen Verzeichnis liegt. Dann bricht er ab.
Außerdem habe ich noch ein weiteres Problem. Die ca. 250 Dateien haben automatische Verknüpfungen zu einer Quelldatei. Somit muß ich bei dem Makro ca. 250x den automatischen Update verneinen. Wie kann ich dies in das Makro mit einbauen? Mit "UpdateLinks=0"?
Schon mal vielen Dank, für die Hilfe, die Ihr schon geleistet habt.
Gruß
Robert

Hi Robert,

Das Update-Problem hast du doch schon selbst gelöst, entsprechende Zeile muß dann heißen:
Workbooks.Open Filename:=.FoundFiles.Item(zähler), UpdateLinks:=0
Klar, daß es bei dir nur bis Text.xls funktioniert, ich hab ja auch gesagt, die Datei sollst du Test.xls nennen, dieser Name wird nämlich abgefragt und umgangen:

...
REM Namenszuweisung
Nam = Pfad & "\Test.xls" 
...
REM Namensüberprüfung
 If .FoundFiles(zähler) <> Nam Then 
...

Von der Sache her ist es also egal, wie du die Datei nennst, du must bloß entsprechende Namenszuweisung und damit Abfrage anpassen.

Gruß

Primut

@Jöke

war tatsächlich nur das fehlende .xls beim Dateinamen in deiner Destination-Anweisung.
Na ja, man lernt halt nie aus... ;-))))))

Gruß

Primut

@Primut

das .xls vergesse ich leider fast immer. ;-(

Gruß

JöKe

Hallo JöKe, Hallo Primut,
vielen Dank für die Super Hilfe. :-)))))
Eine tolle Arbeitserleichterung.
Gruß
Robert

Moin Robert,

vielen Dank für die Rückinfo. Erhält man leider nicht immer.

Gruß

JöKe

Hallo nochmal,
ich möchte ja nicht nerven, habe aber gerade noch eine Sache festgestellt, die ich nicht lösen kann.
Einige der Zellen, die ich rüberkopiere, enthalten Summenformeln. Somit erhalte ich in der "test.xls" Nullwerte oder falsche Werte, weil die Summen aus den falschen Feldern gezogen werden.
Mit welchen Befehlen kann ich die Summenformel als Wert einfügen?
Wenn ich ein Makro zur Probe aufzeichne, erhalte ich den folgenden Befehl:
"Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False"
Leider kenne ich mich mit Makroprogrammierung nicht gut genug aus, um die Formel umzubauen.
Könnt ihr mir nochmal helfen?
Danke.
Gruß
Robert

Hallo Robert,

versuch es mal so:

Option Explicit

Sub Dateien_kopieren()
Application.ScreenUpdating = False
Dim zähler As Long, Pfad As String, Zieldatei As String
Pfad = InputBox("Verzeichnis:", "Welches Verzeichnis?", Default:= _
"C:\Dokumente und Einstellungen\user\Desktop\Test")
If Pfad = "" Then Exit Sub
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Pfad
.SearchSubFolders = True
If .Execute <> 0 Then
For zähler = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
Zieldatei = ActiveWorkbook.Name
Workbooks(Zieldatei).Sheets(1).Range("A1:G1").Copy
Workbooks("Test.xls").Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0). _
PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Workbooks(Zieldatei).Close
Next zähler
End If
End With
Application.ScreenUpdating = True
End Sub


Gruß

JöKe

Hallo JöKe,
ich habe das Makro kopiert und mit allen Dateien/Ordnern ausprobiert, die ich brauche.
Und ... Juchhu ... es klappt. :-)))
Super, nochmals vielen Dank für die Mühe, die ich gemacht habe.
Jetzt habt ihr Ruhe vor mir ... zumindest vorerst :-))
Gruß
Robert

Hallo Robert,

gern geschehen. ;-)

Gruß

JöKe

• Börsenkurse automatisch in excel speichern
• externe Festplatte
• Wie sichere ich meine Daten
• Excel: Verknüpfungen auf Access-DB per Makro aktualisieren
• Nach synchronisierung daten weg