AW: Namen anderer Excel-Datei in Zelle übernehmen
19.09.2008 15:21:53
fcs
Hallo AO,
per Formel ist das so meines Wissens auch nicht möglich.
Per Makro geht es relativ komfortabel. Nachfolgend ein Beispiel, das du noch ein wenig an deine Bedürfnisse anpassen muss.
Das Makro in einem allgemeinen Modul in deiner Übersichtsdatei einfügen.
nach dem Starten des Makros kannst du in einem Datei-Auswahl-Dialog die Dateien auswählen aus denen die Daten eingefügt werden sollen. Beim Start des Makros sollte keine der auszuwählenden Dateien geöffnet sein.
Gruß
Franz
Sub DatenHolen()
'Kopiert Daten aus den ausgewählten dateien und fügt sie im Zieltabellenblatt ein
Dim arrDateien As Variant
Dim lngZeile As Long, lngSpalte As Long, intI As Integer
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Const StartSpalte As Long = 1 'Spalte nach der die Daten eingetragen werden sollen
'Dateien im Dialog auswählen
arrDateien = Application.GetOpenFilename(FileFilter:="Excel (*.xls),*.xls", _
Title:="Monatsdaten einlesen, Bitte Datei(en) auswählen, Mehrfachauswahl ist möglich", _
MultiSelect:=True)
If IsArray(arrDateien) Then
'Zielobjekte setzen
Set wbZiel = ActiveWorkbook 'Datei mit Übersicht
Set wksZiel = wbZiel.Worksheets(1) 'Tabelle in die Eingefügt werden soll
lngSpalte = StartSpalte
'Altdaten in den Spalten löschen
With wksZiel
If .Cells(1, .Columns.Count).End(xlToLeft).Column > lngSpalte Then
.Range(.Columns(StartSpalte + 1), _
.Columns(.Cells(1, .Columns.Count).End(xlToLeft).Column)).ClearContents
End If
End With
Application.ScreenUpdating = False
'Gewählte Dateien abarbeiten
For intI = LBound(arrDateien) To UBound(arrDateien)
'Quelldatei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=arrDateien(intI), ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets(1)
lngSpalte = lngSpalte + 1
'Dateiname in Zeile 1 eintragen
wksZiel.Cells(1, lngSpalte).Value = Left(wbQuelle.Name, Len(wbQuelle.Name) - 4)
'Code zum Kopieren der Werte
wksQuelle.Range("B2:B4").Copy
'Werte in Spalte ab Zeile 2 einfügen
wksZiel.Cells(2, lngSpalte).PasteSpecial Paste:=xlPasteValues
'Quelldatei wieder schliessen
wbQuelle.Close savechanges:=False
Next
'ausgefüllte Spalten nach Zeile 1 sortieren
If lngSpalte > StartSpalte Then
With wksZiel
.Range(.Columns(StartSpalte + 1), .Columns(lngSpalte)).Sort _
Key1:=Cells(1, StartSpalte + 1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
End With
End If
Application.ScreenUpdating = True
Else
Exit Sub
End If
End Sub