Hallo alle miteinander
Ich hab mal wieder ein kleines Problem mit dem einlesen von Dateien.
In der Angehängten Datei "Würfelliste_Einlesen" sollen 5 einzelne Zellen aus mehreren Dateien (z.B. 11. Blatt . xlsx - 13. Blatt . xlsx ) eingelesen werden .Passt auch so weit.
Aber ich möchte diese in einer Formatierten oder Inteligenten Tabelle Eingelesen werden und das Passt nicht.
Er schreibt die Werte immer ans Tabellenende Hmm .
Könnte ihr mir mal bitte weiterhelfen?? und mir im Code reinschreiben wo es nicht past .
Ich gebe es zu den vba-code naja hab ich nicht selbst Geschrieben nur verändert.
Vielen Lieben Dank im vorraus
Du möchtest also die Daten erweitern und nicht immer neu einlesen?
In ein Modul und im Tabellenblatt, in das die Daten eingefügt werden, via button aufrufen!
Vorher den Dateipfad anpassen!
Code:
Option Explicit
Sub DateienAuflisten()
Dim lngZeile As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object
Dim Dateipfad As String
Dateipfad = ThisWorkbook.Path 'Passend ab?ndern!
Set objFileSystem = CreateObject("scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.GetFolder(Dateipfad)
Set objDateienliste = objVerzeichnis.Files
lngZeile = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each objDatei In objDateienliste
If Not objDatei Is Nothing And InStr(objDatei, ".xlsx") And objDatei <> ThisWorkbook.Name Then
With ThisWorkbook.ActiveSheet
.Cells(lngZeile, 1) = objDatei.Name
.Cells(lngZeile, 2).FormulaLocal = "='" & Dateipfad & "\[" & .Cells(lngZeile, 1).Value & "]BETONPR?FUNG leer'!$H$1"
.Cells(lngZeile, 3).FormulaLocal = "='" & Dateipfad & "\[" & .Cells(lngZeile, 1).Value & "]BETONPR?FUNG leer'!$N$6"
.Cells(lngZeile, 4).FormulaLocal = "='" & Dateipfad & "\[" & .Cells(lngZeile, 1).Value & "]BETONPR?FUNG leer'!$V$6"
.Cells(lngZeile, 5).FormulaLocal = "='" & Dateipfad & "\[" & .Cells(lngZeile, 1).Value & "]BETONPR?FUNG leer'!$AD$6"
.Cells(lngZeile, 6).FormulaLocal = "='" & Dateipfad & "\[" & .Cells(lngZeile, 1).Value & "]BETONPR?FUNG leer'!$K$7"
End With
lngZeile = lngZeile + 1
End If
Next objDatei
Application.ScreenUpdating = False
Activesheet.Range("B2:F" & lngZeile).Copy
Activesheet.Range("B2:F" & lngZeile).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Activesheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub
Danke für deine Hilfe ja wenn ich den Code so sehe müsste es klappen
Muss jetzt erst mal zum essen eigentlich zu warm ... .
Ich danke dir erst mal und teste es heute noch aus
Viele Grüße aus Lauenburg
Ronny