monatlich wechselnder Dateinamen/Ordner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Nepumuk,
danke für den Hinweis. Ich hoffe so wird es deutlicher. Anbei einmal das Makro, welches ich mir so über die Videoaufzeichnung annähernd erzeugt habe:

Sub DLB_Daten_einladen()
' DLB_Daten_einladen Makro
Sheets("Mappe1").Select
Workbooks.Open Filename:= _
"M:\Zentrale Datenablage\2020\2020-01\Rohdatendatei_2020_01.xlsx" _
, UpdateLinks:=0
Range("A900:AE900").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A900:AE25443").Select
Selection.Copy
Windows("Beispieldatei.xlsm"). _
Activate
Sheets("Mappe1").Select
Range("A25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Rohdatendatei_2020_01.xlsx").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
Application.CutCopyMode = False
End Sub

Link zur Beispieldatei:
https://www.herber.de/bbs/user/141461.xlsm
Ich habe also eine Auswertungsdatei "Beispieldatei". In diese Datei sollen monatlich Daten aus einer anderen Datei eingeladen werden. Die monatlichen Daten liegen auf einem Gruppenlaufwerk (Netzwerk) und werden jeden Monat in einen fortlaufenden Ordner gelegt. Im Beispiel "2020-01". Im nächsten Monat liegt die Datei im Ordner "2020-02" und wird auch mit einer entsprechenden Dateibezeichnung fortlaufend benannt.
Einen fixen Bezug auf die Datei bekomme ich hin, leider hapert es mit einer dynamischen Verknüpfung.

Hallo Peter,
teste mal:

Option Explicit

Public Sub DLB_Daten_einladen()

    Const FOLDER_PATH As String = "M:\Zentrale Datenablage\"

    Dim strYear As String, strMonth As String, strPath As String
    Dim objWorkbook As Workbook

    If Cells(6, 2).Text Like "####-##" Then

        strYear = Split(Cells(6, 2).Text, "-")(0)
        strMonth = Split(Cells(6, 2).Text, "-")(1)

        strPath = FOLDER_PATH & strYear & "\" & Cells(6, 2).Text & "\Rohdatendatei_" & Cells(6, 2).Text & ".xlsx"

        If Dir$(PathName:=strPath) <> vbNullString Then

            Call Range(Cells(25, 1), Cells(Rows.Count, Columns.Count)).ClearContents

            Set objWorkbook = GetObject(PathName:=strPath)

            With objWorkbook.Worksheets(1)
                Call .Range(.Cells(900, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 31)).Copy
            End With

            Call Cells(25, 1).PasteSpecial(Paste:=xlPasteValuesAndNumberFormats)

            Application.CutCopyMode = False

            Call objWorkbook.Close(SaveChanges:=False)

        Else
            Call MsgBox("Datei nicht gefunden.", vbExclamation, "Hinweis")
        End If
    Else
        Call MsgBox("Bitte den Zeitraum im Format JJJJ-MM eintragen.", vbExclamation, "Hinweis")
    End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

monatlich wechselnder Dateinamen/Ordner

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread