vielleicht hilft das:
Mehrere Spalten aus versch. excel files in ein file zusammenkopieren

(siehe dort mein Beitrag, Antwort 6)

Gruß, kicia

achso, da war der Code zum Verzeichnis auslesen gar nicht dabei.
Das also hier:

(beachte, daß das script eine weile brauchen kann, wenn viele Dateien in den Ordnern sind)

var files = getFiles( "C:/com" , 0 );
var i = 0;
var out = [];
files = files[1];
for( i = 0; i < files.length; i++ )
{
	out.push( files[i].path );
}
WScript.Echo( out.join("\r\n") );

//-----------------------------------------------------------------------------------
//-- returns an array: [ array of folder objects, array of file objects ]
//-- n = 0001 (1): no folders
//-- n = 0010 (2): no files
//-- n = 0100 (4): no subfolders
//-----------------------------------------------------------------------------------
function getFiles( startfolder, n )
{
	if( !n ) n = 0;
	var fso     = new ActiveXObject("Scripting.FileSystemObject");
	var folders = new Array();
	var files   = new Array();
	if( !fso.FolderExists( startfolder ) )
	{
		msg("Folder " + startfolder + " not found!");
		return [ [],[] ];
	}
	getNext( startfolder );
	return [ folders, files ];
	
	function getNext( fld )
	{
		var folderObj = fso.getFolder( fld );
		var filesEn, foldersEn;

		if( (n & 2) == 0 )
		{
			filesEn   = new Enumerator( folderObj.Files );
			for (; !filesEn.atEnd(); filesEn.moveNext()) files.push( filesEn.item() );
		}
		if( (n & 1) == 0 )
		{
			folders.push( folderObj );
		}
		if( (n & 4) == 0 )
		{
			foldersEn = new Enumerator( folderObj.SubFolders );
			for (; !foldersEn.atEnd(); foldersEn.moveNext()) getNext( foldersEn.item().path );
		}
	}
}

Hallo new,

lade Dir mal unter dem Link http://www.excelbeispiele.de/Beispiele_Supportnet/Beispiel_Pfad_wir... diese Datei herunter. Dort wird für jeden Pfad, der ausgewählt wurde, ein Hyperlink zur Datei erstellt.
Anstelle der Hyperlinks musst Du die Datei mit der ".Open-Eigenschaft" öffnen, dann die Zelle mit "Range("A1").Copy" kopieren und mit der ".Close-Eigenschaft" die Datei wieder schließen.

Ich hoffe, Du kommst klar.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver!
Danke

hab aber ein kleines Programmierproblem:
bitte schaus dir unten mal an:
unter:
ich möchte nicht die Hyperlinks sondern den Inhalt
des Bereichs A1-B3 aller ma.xls Dateien aufgelistet haben!!!!

vielen dank!!!
mfg new

'*********************************************************************************************
'*                                                                                           *
'*                               Projektierung und Realisierung                              *
'*                                           durch                                           *
'*                                    Oliver Scheckelhoff                                    *
'*                               http://www.excelbeispiele.de                                *
'*                                  info@excelbeispiele.de                                   *
'*                                                                                           *
'*                                                                                           *
'*           #######  ####      ####    ########   #######  ###                              *
'*          ########   ####    ####    #########  ########  ###                              *
'*          ###          #### ####     ###        ###       ###                              *
'*          ########      #######      ##         ########  ###                              *
'*          ########      #######      ##         ########  ###                              *
'*          ###         ####  ######   ###        ###       ###                              *
'*          ########   ####    ####    #########  ########  ########                         *
'*           #######  ####    #######   ########   #######   #######  beispiele.de           *
'*                                                                                           *
'*                © 2007 Copyright Oliver Scheckelhoff, Alle Rechte vorbehalten              *
'*                                                                                           *
'*          Diese Datei unterliegt dem Urhebergesetz und ist somit Eigentum von              *
'*                                  Oliver Scheckelhoff                                      *
'*                                                                                           *
'*      Jegliches Verändern der Datei oder des VBA-Codes ist strengstens verboten.           *
'*                      Zuwiderhandlung wird strafrechtlich verfolgt                         *
'*                                                                                           *
'*********************************************************************************************

Option Explicit

Dim Obj As Object
Dim Dateien As Object
Dim Durchläufe As Object
Dim Dateityp As Object

Sub Auflistung_start()
Dim strPfad As String
Dim i As Integer

'Pfad auswählen
strPfad = GetDirectory("Bitte Ordner auswählen") & "\"
'Wenn kein Pfad ausgewählt, Prozdur beenden
If strPfad = "\" Or strPfad = "" Then Exit Sub
'Falls Backslash feht, diesen anhängen
If Len(strPfad) = 4 Then strPfad = Mid(strPfad, 1, 3)
On Error GoTo Ende
'For/ Next-Schleife zum Prüfen ob Bltt "Auswertung bereits existiert
For i = 1 To Worksheets.Count
    'Wenn durch die Schleife abgefragter Blattname gleich "Auflistung", dann...
    If Sheets(i).Name = "Auflistung" Then
        '... Meldungen deaktivieren
        Application.DisplayAlerts = False
        'Blatt "Auflistung" löschen und...
        Sheets(i).Delete
        '... Meldungen wieder aktivieren und...
        Application.DisplayAlerts = True
        '...Schleife beenden
        Exit For
    End If
Next
'Neues Tabellenblatt mit dem Namen "Auflistung" erstellen
With Worksheets.Add
    .Name = "Auflistung"
End With
'Verweis Obj setzen
Set Obj = CreateObject("Scripting.FileSystemObject")
'Verweis Dateien setzen
Set Dateien = Obj.getfolder(strPfad)
'Makro Auflistung ausführen
Call Auflistung
Ende:
End Sub

Sub Auflistung()
Dim i As Integer
'Bildschirmaktualisierung deaktivieren
Application.ScreenUpdating = False
'Schleife zum Durchlaufen des ausgewählten Verzeichnisses
For Each Dateityp In Dateien.Files
    If Right(Dateityp.Name, 4) = "ma.xls" Then _
    
        '**********
        '**********
        '**********Hier möchte ich nicht die Hyperlinks sondern den Inhalt
        '**********des Bereichs A1-B3 aller ma.xls Dateien aufgelistet haben!!!!
        
        Workbooks.Open "Dateityp.files"
        Range(A1, [B3]).Copy
        Workbooks.Close
                
        '**********
        '**********
        '**********
                
    End If
Next
'Schleife um Unterverzeichnisse durchzulaufen
For Each Durchläufe In Dateien.subfolders
    Set Dateien = Durchläufe
    Call Auflistung
Next
Sheets("Auflistung").Columns("A:A").EntireColumn.AutoFit
End Sub

Hallo new,

dann sieht das Makro wie folgt aus:

Option Explicit

Dim Obj As Object
Dim Dateien As Object
Dim Durchläufe As Object
Dim Dateityp As Object

Sub Auflistung_start()
Dim strPfad As String
Dim i As Integer

'Pfad auswählen
strPfad = GetDirectory("Bitte Ordner auswählen") & "\"
'Wenn kein Pfad ausgewählt, Prozdur beenden
If strPfad = "\" Or strPfad = "" Then Exit Sub
'Falls Backslash feht, diesen anhängen
If Len(strPfad) = 4 Then strPfad = Mid(strPfad, 1, 3)
On Error GoTo Ende
'For/ Next-Schleife zum Prüfen ob Bltt "Auswertung bereits existiert
For i = 1 To Worksheets.Count
    'Wenn durch die Schleife abgefragter Blattname gleich "Auflistung", dann...
    If Sheets(i).Name = "Auflistung" Then
        '... Meldungen deaktivieren
        Application.DisplayAlerts = False
        'Blatt "Auflistung" löschen und...
        Sheets(i).Delete
        '... Meldungen wieder aktivieren und...
        Application.DisplayAlerts = True
        '...Schleife beenden
        Exit For
    End If
Next
'Neues Tabellenblatt mit dem Namen "Auflistung" erstellen
With Worksheets.Add
    .Name = "Auflistung"
End With
'Verweis Obj setzen
Set Obj = CreateObject("Scripting.FileSystemObject")
'Verweis Dateien setzen
Set Dateien = Obj.getfolder(strPfad)
'Makro Auflistung ausführen
Call Auflistung
Ende:
End Sub

Sub Auflistung()
Dim i As Integer
Dim intFirstRow As Integer
'Bildschirmaktualisierung deaktivieren
Application.ScreenUpdating = False
'Schleife zum Durchlaufen des ausgewählten Verzeichnisses
For Each Dateityp In Dateien.Files
    If Dateityp.Name = "ma.xls" Then _
        'erste freie Zeile in Zieldatei ermitteln
        intFirstRow = ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Row
        'gefundene Quelldatei im Hintergrund öffnen
        GetObject (Dateityp)
        'Bereich in Quelldatei kopieren
        Workbooks("ma.xls").Sheets(1).Range("A1:B3").Copy
        'Daten in Zieldatei einfügen
        ThisWorkbook.Sheets("Auflistung").Cells(intFirstRow, 1).PasteSpecial
        'Quelldatei schließen
        Workbooks("ma.xls").Close
              
    End If
Next
'Schleife um Unterverzeichnisse durchzulaufen
For Each Durchläufe In Dateien.subfolders
    Set Dateien = Durchläufe
    Call Auflistung
Next
Sheets("Auflistung").Columns("A:A").EntireColumn.AutoFit
End Sub

Mit dem Makro wird die gefundene Datei geöffnet und der Bereich "A1:B3" im 1. Tabellenblatt kopiert und in Blatt "Auswertung" in der ersten freien Zeile eingefügt. Danach wird die Datei wieder geschlossen.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Vielen lieben Dank Oliver,
ja es hat geklappt, nur:

in den dateien waren verweisen, und -das liegt jetzt nicht am script- wenn man verweise kopiert, dann ändert das die ursprünglich angegebenen Zellen.

Also hab ich mir gedacht, warum so umständlich, dann lasse ich es gleich von der eigentlichen datei berechnen. ist bestimmt einfach zu lösen, komme nun aber wieder nicht weiter:

ich möchte zweimal die summen aus unterschiedlichen zellen berechnen und diese zwei summen dann dividieren. das ergebniss soll dann in die hauptdatei kopiert werden.

das stimmt so nicht:

Workbooks("Eurokalk.XLS").Sheets(1).Range("E2:F2").Formula = "=Sum(E2:F2)".Copy

danke
new

Hallo New,

kannst Du mal etwas genauer werden. Welche Zellen sollen berechnet werden, also z.B. A1+B1/C1. Dann kann man eine Lösung präsentieren.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo,
also ganz genau sollte es so gehen:

Aus der Datei F16 minus F317
das Ergebniss

durch die summe von F312:F315
dividieren und mit 100 multiplizieren.

dann noch 2 Zellen Text anzeigen, das wars!

thx


mfg new

Hallo new,

nachfolgende Code-Zeilen sollten Dir das Ergebnis aus der Berechnung aus der Datei "ma.xls" in Deine Zieldatei in Blatt "Auswertung" in Zelle A1 eintragen.

With Workbooks("ma.xls").Sheets(1)
    ThisWorkbook.Sheets("Auflistung").Range("A1") = _
        ((.Range("F16") - .Range("F317")) / Application.WorksheetFunction.Sum(.Range("F312:F315"))) * 100
End With

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}