VBA - Kopieren von bestimmten Zellen wenn Datum
10.03.2019 20:02:43
bestimmten
erstmal Danke für die Super Beiträge hier,
viele Probleme vor die ich aktuell auf Arbeit gestellt wurde konnte ich super einfach durch Recherche hier im Forum beheben!
Eines bringt mich aktuell jedoch ins Schwitzen:
Und zwar habe ich viele große Excel Dateien die alle gleich aufgebaut sind,
A3:I3 Überschriften und darunter dann viele Einträge mit dem Tagesdatum in Zelle A.
Nun hätte ich gerne eine zweite Excel-Datei in der ich ein Datum angeben (Zelle oder UserForm) und dann alle Einträge aus den vielen einzelnen Dateien für das angegebene Datum auslesen lassen kann, so dass ich nicht jede Datei täglich einzeln öffnen und die Daten übertragen muss.
Nachfolgender VBA Code beschreibt ganz gut was ich gerne hätte, jedoch lässt sich hier bisher ja nicht nach Datum sortieren sondern nur die angegebene Range kopieren.
Private Sub CommandButton1_Click()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
'** Angaben zur auszulesenden Zelle
pfad = "\\pfad\zum\ordner"
datei = "maschine_xy.xlsx"
blatt = "OEE"
Set bereich = Range("A12:H19")
'** Bereich auslesen
For Each zelle In bereich
'** Zellen umwandeln
zelle = zelle.Address(False, False)
'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , _
xlR1C1)
'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Bin nun schon einige Stunden dran und habe Hauptsächlich mit Range.Find herumprobiert, jedoch ohne Erfolg da mir einfach die Kenntnisse fehlen.
Wäre Super wenn mir jemand auf die Sprünge helfen könnte.
Vielen Dank und schönen Abend noch,
Thomas
Anzeige