VBA Daten aus anderer Datei aktualisieren

Hallo Excel und VB-Profis,
ich habe ein kleines Problem welches ich nicht lösen kann und hoffe, dass ihr mir helfen könnt:
Es gibt eine Excel-Datei, Excel-Tool, in welcher sich ein Tabellenblatt Daten befindet. In diesem Tabelenblatt Daten befinden sich einige Spalten mit der Überschrift Name, Adresse, Telefon und entsprechenden Einträgen in den einzelnen Spalten.
In einer zweiten Excel-Datei befinden sich mehrere Spalten, unter anderem auch Name, Adresse und Telefon aber auch PLZ, Schuhgröße und einige andere. Problem dabei ist, dass diese zweite Datei immer anders heißt, z.B. report123456 oder report 12347777, auch das Tabellenblatt heißt nicht immer gleich, es ist allerdings immer nur ein Tabelenblatt in der Datei vorhanden. Die Datei liegt jedoch immer im selben Ordner report auf dem Laufwerk C:.
Nun benötige ich in der Datei Excel-Tool einen Button, und durch drücken dieses Buttons sollen sich die Spalten Name, Adresse und Telefon aktualisieren und sich die neuen Daten aus dem neusten Report im Ordner Report ziehen.
Ich hoffe das ist verständlich.
Vielen Dank im Voraus für eure Hilfe.
MfG
SonOdin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Daten_aus_neuster_Datei() Dim sDatei As String, sPath As String Dim sExt As String, sPre As String Dim StoreDate As Date, StoreName As String Dim WB, TB1, sTB2 Dim dLR As Double, iLC As Integer, iSP As Integer '**** Variablen setzen sPath = "X:\Temp\report\" 'mit '\' am Ende sExt = "*.xls" 'Dateierweiterung sPre = "report*" 'Dateiname Anfang Set TB1 = Sheets("Daten") iSP = 1 'Spalte mit Name '**** If Dir(sPath, vbDirectory) = "" Then MsgBox "Das Verzeichnis: '" & sPath & "' konnte nicht gefunden werden! " Exit Sub Else If Dir(sPath & sPre & sExt) = "" Then MsgBox "Keine Dateien dieses Typs '" & sExt & "' gefunden" Exit Sub End If sDatei = Dir(sPath & sPre & sExt) StoreDate = FileDateTime(sPath & sDatei) End If 'Jüngste Datei finden Do While (sDatei <> "") If FileDateTime(sPath & sDatei) > StoreDate Then StoreDate = FileDateTime(sPath & sDatei) StoreName = sDatei End If sDatei = Dir() 'Nächste Datei Loop 'Datei öffnen, Name der ersten Tabelle lesen Set WB = Workbooks.Open(sPath & StoreName) sTB2 = WB.Worksheets(1).Name WB.Close 'Formeln für Sverweis setzen With TB1 dLR = .Cells(.Rows.Count, iSP).End(xlUp).Row 'letzte Zeile der Spalte iLC = .Cells(1, .Columns.Count).End(xlToLeft).Column 'letzte Spalte der Überschrift With .Range(.Cells(2, iSP + 1), .Cells(dLR, iLC)) 'Formeln .FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC1,'" & sPath & "[" & StoreName & "]" & sTB2 & _ "'!C1:C26,MATCH(R1C,'" & sPath & "[" & StoreName & "]" & sTB2 & "'!R1,0),0),"""")" 'Formeln in Wert .Value = .Value End With End With 'Info MsgBox ("Die jüngste Datei ist: '" & StoreName & "' , erstellt am " & StoreDate) End Sub

Hallo nochmal
Der Fehler trat auf, wenn nur eine Datei im reportverzeichnis lag (Zum Testen hatte ich bei mir natürlich Mehrere)
habe ich jetzt behoben.

Option Explicit
 
Sub Daten_aus_neuster_Datei()
    Dim sDatei As String, sPath As String
    Dim sExt As String, sPre As String
    Dim StoreDate As Date, StoreName As String
     
    Dim WB, TB1, sTB2
    Dim dLR As Double, iLC As Integer, iSP As Integer, iZe As Integer
     
    '**** Variablen setzen 
    sPath = "C:\report\" 'mit '\' am Ende 
    sPath = "x:\Temp\report\" 'mit '\' am Ende 
    sExt = "*.xls" 'Dateierweiterung 
    sPre = "report*" 'Dateiname Anfang 
    Set TB1 = Sheets("Daten")
    iSP = 1 'Spalte mit Name 
    iZe = 2 'erste DatenZeile 
    '**** 
     
    If Dir(sPath, vbDirectory) = "" Then
        MsgBox "Das Verzeichnis: '" & sPath & "' konnte nicht gefunden werden! "
        Exit Sub
    Else
        If Dir(sPath & sPre & sExt) = "" Then
            MsgBox "Keine Dateien dieses Typs '" & sExt & "' gefunden"
            Exit Sub
        End If
        sDatei = Dir(sPath & sPre & sExt)
        StoreName = sDatei
        StoreDate = FileDateTime(sPath & sDatei)
    End If
     
    'Jüngste Datei finden 
    Do While sDatei <> ""
        If FileDateTime(sPath & sDatei) > StoreDate Then
            StoreDate = FileDateTime(sPath & sDatei)
        End If
        sDatei = Dir() 'Nächste Datei 
    Loop
     
    'Datei öffnen, Name der ersten Tabelle lesen 
    Set WB = Workbooks.Open(sPath & StoreName)
    sTB2 = WB.Worksheets(1).Name
    WB.Close
     
    'Formeln für Sverweis setzen 
    With TB1
        dLR = .Cells(.Rows.Count, iSP).End(xlUp).Row 'letzte Zeile der Spalte 
        dLR = WorksheetFunction.Max(dLR, iZe)
        
        iLC = .Cells(1, .Columns.Count).End(xlToLeft).Column 'letzte Spalte der Überschrift 
         
        With .Range(.Cells(2, iSP + 1), .Cells(dLR, iLC))
            'Formeln 
            .FormulaR1C1 = _
                "=IFERROR(VLOOKUP(RC1,'" & sPath & "[" & StoreName & "]" & sTB2 & _
                "'!C1:C26,MATCH(R1C,'" & sPath & "[" & StoreName & "]" & sTB2 & "'!R1,0),0),"""")"
                 
            'Formeln in Wert 
            .Value = .Value
        End With
    End With
     
    'Info 
    MsgBox ("Die jüngste Datei ist: '" & StoreName & "' , erstellt am " & StoreDate)
End Sub

- Du hast den Code in DieseArbeitsmappe gelegt.
- Geht zwar, ist aber ungewöhnlich. Normal gehören diese Art Makros in ein Modul
LG UweD

Beliebteste Forumthreads (12 Monate)

VBA Daten aus anderer Datei aktualisieren

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

348 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Daten aus anderer Datei aktualisieren

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

348 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread