Funktion Datei auslesen

Public Sub DateienAuslesen3(ByVal pfad As String) Dim Ziel As Worksheet Dim Quelle As Worksheet Application.ScreenUpdating.Updating = False Set Ziel = ActiveWorkbook.ActiveSheet Set Quelle = Workbooks.Open(Filename:=pfad).Worksheets(1) Quelle.Range(Cells(40, 4), Cells(40, 72)).Copy Ziel.Range(Cells(40, 4), Cells(40, 72)).Select Sheets(ActiveSheet).Cells(ActiveRange).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ _ SkipBlanks:=False, Transpose:=False Sheets(ActiveSheet).Cells(ActiveRange).PasteSpecial Paste:=xlPasteValues Quelle.Parant.Close Set Quelle = Nothing Set Ziel = Nothing End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub DateiAuslesen() 'Dateipfad und Zellbereich könnten auch als Parameter 'übergeben werden '----- Anpassen ab hier ----- Const Pfad As String = "C\DeinPfad\DeineDatei.xlsx" Const ZellBereich As String = "D40:BT40" '----- Anpassen bis hier ----- Dim QuellMappe As Workbook Dim QuellBlatt As Worksheet Dim ZielMappe As Workbook Dim ZielBlatt As Worksheet Application.ScreenUpdating = False Set ZielMappe = ThisWorkbook Set ZielBlatt = ZielMappe.ActiveSheet Set QuellMappe = Workbooks.Open(Pfad) Set QuellBlatt = QuellMappe.Worksheets(1) QuellBlatt.Range(ZellBereich).Copy ZielBlatt.Range(ZellBereich).PasteSpecial xlPasteValues ZielBlatt.Range(ZellBereich).PasteSpecial xlPasteFormats QuellMappe.Close False Set QuellBlatt = Nothing Set QuellMappe = Nothing Set ZielBlatt = Nothing Set ZielMappe = Nothing With Application .ScreenUpdating = True .CutCopyMode = False End With End Sub

Hallo!
Achso alles klar
Scheint mir nicht so!
Du solltest Code und Hinweise, die Dir gegeben werden, auch lesen!
Zu kann ich den Pfad ganz normal als Parameter übergeben wie bei der Funktion?
steht in meinem Kommentar 'Dateipfad und Zellbereich könnten auch als Parameter übergeben werden
Und wie kann ich die Prozedur dann in einer Zelle aufrufen?
Wie Luc bzw. ich Dir geschrieben haben: Was Du machen willst, lässt sich nicht als Zellfunktion ausführen. Du musst dieses Makro also anderweitig aufrufen (zB durch eine Schaltfläche, oder ein Zell-Ereignis...)
Es geht nämlich um mehrere Dateien
Davon war nie die Rede; wenn Du schon merkst, dass Du eigentlich nicht weißt, wie ein Problem zu lösen ist, warum zeigst Du uns nicht von Anfang an ALLE Details und KONKRETEN Verhältnisse, damit wir Dir entsprechenden Code zur Verfügung stellen können?
Hierzu musst Du (vermutlich) zellenweise in einer Schleife abarbeiten; aber das schreibe ich erst, wenn ich genau weiß, dass die Sache dann erledigt ist. Sonst dauert dieser Faden bis morgen! Zeig also bitte eine Beispieldatei (Ausgangslage und beispielhafte Zielsetzung).
LG
Michael

Hallo!
Weil ich ja nicht so bin... Falls das dies Deinen Verhältnissen entspricht:
Tabelle2

	A	B	C	D	E	F	G	H	I	J
1	Dateiliste	Kopierbereich		Kopierte Daten ab Spalte D (zeilenweise)
2	MeineDatei.xlsx	A5:D5		Lorem	Lorem	Lorem	Lorem
3	AndereDatei.xlsx	B6:H10		ipsum	ipsum	ipsum	ipsum	ipsum	ipsum	ipsum
4	NeueDatei.xlsx	C2:F2		dolor	dolor	dolor	dolor
5

...kann das folgendes Makro bewerkstelligen (die Parameter Dateiname und zu kopierender Bereich wären in diesem Fall die Zellinhalte, Pfad muss im Makro angegeben werden):

Sub DateienNachZeilenAuslesen()
'Dateinamen auf aktivem Blatt in A2:Ax durchgehen und
'jeweilige Datei öffnen, den in B2:Bx des aktiven Blattes
'angegebenen Bereich kopieren und in D2:Dx einfügen. Ist
'der angegebene Bereich ein mehrzeiliger Bezug, wird auf
'die erste Zeile des Bezugs reduziert.
'Nicht vorhandene Dateien werden ignoriert, ein fehlender
'abschließender "\" im Pfad wird ergänzt.
'----- Anpassen ab hier -----
Const Pfad As String = "C:\DeinPfad"
'----- Anpassen bis hier -----
Dim QuellMappe As Workbook
Dim QuellBlatt As Worksheet
Dim QuellBereich As String
Dim Dateien As Range
Dim Datei As Range
Dim Dname As String
Dim ZielMappe As Workbook
Dim ZielBlatt As Worksheet
Dim Zielbereich As String
Application.ScreenUpdating = False
Set ZielMappe = ThisWorkbook
Set ZielBlatt = ZielMappe.ActiveSheet
'Zellen A2 bis zur letzten gefüllten Zelle in A durchgehen
With ZielBlatt
Set Dateien = .Range("A2:A" & _
.Cells(.Rows.Count, 1).End(xlUp).Row)
End With
For Each Datei In Dateien
'In den Zellen stehen die zu öffnenden Dateinamen
Dname = Datei.Text
'Evtl. fehlenden "\" im Pfad ergänzen
If Right(Pfad, 1)  "\" Then Dname = "\" & Dname
'Der Zielbereich startet in Spalte D der aktuellen Zeile
Zielbereich = Datei.Offset(0, 3).Address
'Nicht vorhandene Dateien werden ignoriert
If Dir(Pfad & Dname, vbDirectory)  vbNullString Then
Set QuellMappe = Workbooks.Open(Pfad & Dname)
Set QuellBlatt = QuellMappe.Worksheets(1)
'In Spalte B stehen die Quelladressen der Quelldateien
QuellBereich = Datei.Offset(0, 1).Text
'Mehrzeilige Bezüge werden auf die erste Zeile reduziert!)
With QuellBlatt.Range(QuellBereich)
If .Rows.Count > 1 Then
QuellBereich = .Rows(1).Address
End If
End With
'Werte und Formate aus dem Zielbereich werden in den
'Quellbereich geschrieben und Quelle geschlossen
QuellBlatt.Range(QuellBereich).Copy
ZielBlatt.Range(Zielbereich).PasteSpecial xlPasteValues
ZielBlatt.Range(Zielbereich).PasteSpecial xlPasteFormats
QuellMappe.Close False
End If
Next Datei
'Aufräumen
Set QuellBlatt = Nothing: Set QuellMappe = Nothing: Set ZielBlatt = Nothing
Set ZielMappe = Nothing: Set Dateien = Nothing: Set Datei = Nothing
With Application
.ScreenUpdating = True
.CutCopyMode = False
End With
End Sub

Wie gesagt, Anpassungen nur nach konkreten Details!
LG
Michael

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread