Daten aus unterschiedlichen Dateien

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Musa,
Rechtsklick auf den Tabellenreiter - Code anzeigen. Folgende Prozedur einfügen:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strDate As String
    Dim objWorkbook As Workbook, objCell As Range
    Dim lngRow As Long
    If Target.Address = "$B$2" Then
        If IsDate(Target.Value) Then
            strDate = Format$(Target.Value, "yyyy_mm_dd")
            If Dir$(ThisWorkbook.Path & "\" & strDate & ".xlsx") <> vbNullString Then
                Set objWorkbook = GetObject(PathName:=ThisWorkbook.Path & "\" & strDate & ".xlsx")
                For lngRow = 4 To Cells(Rows.Count, 2).End(xlUp).Row
                    Set objCell = objWorkbook.Worksheets(1).Cells.Find(What:=Cells(lngRow, 2).Text, _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                    If Not objCell Is Nothing Then Cells(lngRow, 3).Value = objCell.Offset(0, 1).Value
                    Set objCell = Nothing
                Next
                Call objWorkbook.Close(SaveChanges:=False)
                Set objWorkbook = Nothing
            Else
                Call MsgBox("Datei nicht gefunden", vbExclamation, "Hinweis")
            End If
        Else
            Call MsgBox("Kein gültiges Datum.", vbExclamation, "Hinweis")
        End If
    End If
End Sub

Gruß
Nepumuk

Hallo Musa,
ich habe keinen Server, daher kann ich nicht testen ob es so funktioniert:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const FOLDER_PATH As String = "https://.../" 'Anpassen !!! Slash am Ende nicht löschen
    Dim strDate As String
    Dim objWorkbook As Workbook, objCell As Range
    Dim lngRow As Long
    On Error GoTo err_exit
    If Target.Address = "$B$2" Then
        If IsDate(Target.Value) Then
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
            End With
            strDate = Format$(Target.Value, "yyyy_mm_dd")
            Set objWorkbook = GetObject(PathName:=FOLDER_PATH & strDate & ".xlsx")
            For lngRow = 4 To Cells(Rows.Count, 2).End(xlUp).Row
                Set objCell = objWorkbook.Worksheets(1).Cells.Find(What:=Cells(lngRow, 2).Text, _
                    LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                If Not objCell Is Nothing Then
                    Cells(lngRow, 3).Value = objCell.Offset(0, 1).Value
                    Cells(lngRow, 4).Value = objCell.Offset(0, 2).Value
                    Cells(lngRow, 5).Value = objCell.Offset(0, 3).Value
                End If
                Set objCell = Nothing
            Next
            Call objWorkbook.Close(SaveChanges:=False)
            Set objWorkbook = Nothing
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
        Else
            Call MsgBox("Kein gültiges Datum.", vbExclamation, "Hinweis")
        End If
    End If
    Exit Sub
    err_exit:
    Call MsgBox("Datei nicht gefunden", vbExclamation, "Hinweis")
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Daten aus unterschiedlichen Dateien

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread