100 Dateien nach Wert durchs. und in neue Datei...

Forumthread: 100 Dateien nach Wert durchs. und in neue Datei...

17.11.2008 11:31:00

Jessi

Hallo zusammen,
ich habe ein Problem, bzw. einen riesen Arbeitsaufwand vor mir, sofern ich das nicht per VBA gelöst bekomme.
Ich habe ca. 100 Dateien (Excel) die logisch nummeriert sind als Name:
Bsp:
1.xlsm
2.xlsm
(...)
99.xlsm
In jeder dieser Tabelle steht eine -Wert in der Zelle U4. Dieser Wert sollte auf ein externes neues Tabellenblatt ausgelesen werden inkl. der Datei-Nr.
z.B.
Spalte A
43
Spalte B
30.094.943,00
Hat da einer eine Idee wie das funktionieren könnte?
Grüße und DANKE vorab.
Jessi

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: 100 Dateien nach Wert durchs. und in neue Datei...

17.11.2008 12:04:00

Rudi
hat geklappt! DANKE

17.11.2008 12:55:00

Jessi
Dateinamen nicht bekannt?

17.11.2008 12:51:00

Tino

AW: 100 Dateien nach Wert durchs. und in neue Datei...

17.11.2008 12:04:00

Rudi

Hallo,


Sub tt()
Dim i As Integer, arrFormel(1 To 99, 1 To 2)
For i = 1 To 99
arrFormel(i, 1) = i
arrFormel(i, 2) = "=[" & i & ".xlsm]Tabelle1!U19"
Next
Cells(1, 1).Resize(99, 2) = arrFormel
End Sub

Gruß
Rudi

hat geklappt! DANKE

17.11.2008 12:55:00

Jessi

super danke, hat funktioniert.
Die #Bezugfehler, sofern kein Wert vorhanden ist, kann ich gesondert rausfiltern. ;-)
DANKE!

Dateinamen nicht bekannt?

17.11.2008 12:51:00

Tino

Hallo,
hier mal eine Möglichkeit ohne die Datei zu öffnen,
der Tabellenname in den Dateien muss aber gleich sein, hier im Beispiel Tabelle1.
Getestet unter xl2007

Option Explicit

Sub Test()
Dim Fso, Ordner, varDatei
Dim DateiName As String
Dim i As Long
'ab welcher Zeile einfügen 
i = 2
Set Fso = CreateObject("Scripting.FileSystemObject")
'hier Pfad angeben 
Set Ordner = Fso.getfolder("J:\1 Forum")
'Schleife über alle Dateien im Ordner 
For Each varDatei In Ordner.Files
 If LCase(varDatei) Like "*.xlsm" Then
    
    'Dateiname ausfiltern 
   DateiName = LCase(Right$(varDatei, Len(varDatei) - InStrRev(varDatei, "\")))
    If IsNumeric(Replace(DateiName, ".xlsm", "")) Then
      'Name der Datei schreiben ohne Extention 
      Cells(i, "A") = Replace(DateiName, ".xlsm", "")
      'String Formel erstellen, Achtung hier ist der Tabellenname zu beachten, hier Tabelle1 
      DateiName = "'" & Replace(varDatei, DateiName, "[" & DateiName & "]Tabelle1'!" & Range("U4").Address(ReferenceStyle:=xlR1C1))
      'schreibe Wert in Zelle 
      Cells(i, "B") = ExecuteExcel4Macro(DateiName)
      'Zähler hochzählen für nächste Zeile 
      i = i + 1
    End If
 
 End If
Next varDatei

End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

100 Dateien nach Wert durchs. und in neue Datei...

Forumthread: 100 Dateien nach Wert durchs. und in neue Datei...

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread