Werte in die korrekte Position einer anderen Datei
17.02.2016 16:14:21
Andreas
ich bin ein ziemlicher VBA-Neuling. Ich habe zwar schon einiges geschafft und die Arbeit macht mir auch viel Spaß aber an einer Aufgabe verzweifele ich langsam.
Ich möchte aus einer Datei (aus dem Sheet "Testmakro") 42 Werte in eine andere Datei ("Testfile") kopieren. Das Besondere dabei ist, dass die Datei, in die die Werte hineinkopiert werden sollen, jeden Tag einen anderen Namen hat (z.B. heute heißt sie "20160217_Testfile", morgen heißt sie "20160218_Testfile)
Ich habe es inzwischen geschafft die Datei ("Testfile"), unabhängig vom aktuellen Datum zu öffnen, und die alte Datei ins Archiv zu verschieben.
Mein Problem ist jetzt, dass die Werte aus dem Sheet TestMakro auf die richtige Position in der Datei "Testfile" eingefügt werden müssen. Dazu muss ich allerdings noch sagen, dass die Datei "Testfile" 12 verschiedene Reiter hat (Jan 16, Feb 16, März 16 usw).
Die Zeile aus der die Werte ausgelesen werden sollen (aus dem Sheet "TestMakro"), werden täglich angepasst. Heute stehen also in dieser Zeile alle Werte für den 17.02.2016, morgen stehen dort alle Werte für den 18.02.2016. Hierfür bräuchte man also keine Suchroutine, weil die Zeile immer gleich bleibt.
Ich benötige eine Suchroutine, die zum einen überprüft, ob sich das Datum innerhalb eines Monats befindet. Das habe ich schon hinbekommen und das richtige Sheet in der Datei "Testfile" wird auch ausgewählt.
Jetzt habe ich aber das Problem, dass die Werte auch in die richtige Zeile eingetragen werden müssen. Im Reiter "Feb 16" habe ich beispielsweise eine Liste von dem 01.02.2016 bis zum 29.02.2016. Die Werte für heute sollen dann auch in die Zeile für den 17.02.2016 eingetragen werden.
Das war jetzt sehr viel Text aber ich wusste nicht wie ich das kompakter erklären kann. Vielleicht wird es auch deutlicher wenn man sich Quelltext ansieht.
Vielen Dank schon einmal für eure Hilfe
Andreas
Im Quelltext habe ich nur den Feb und März eingetragen. Die restlichen Monate habe ich der Ü _
bersicht halber gelöscht.
Sub Werteübertragen()
Dim Dateiname As String
Dim Pfad As String
Dim teil As String
Dim aktuelles_Datum As String
Dim Archiv As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Pfad = "I:\xyz\"
teil = "?_Testfile.xlsx"
Dateiname = Dir(Pfad & teil)
aktuelles_Datum = Format(Now, "YYYYMMDD")
Do While Dateiname ""
Workbooks.Open Filename:=Pfad & Dateiname
ActiveWorkbook.SaveAs Filename:=Pfad & aktuelles_Datum & Right(Dateiname, 14)
fso.MoveFile Pfad & Dateiname, "xyz\Archiv\"
'Datumskontrolle Feb
If ThisWorkbook.Worksheets("TestMakro").Range("A3") >= ThisWorkbook.Worksheets("TestMakro"). _
Range("B1") _
And ThisWorkbook.Worksheets("TestMakro").Range("A3") = ThisWorkbook.Worksheets(" _
TestMakro").Range("C1") _
And ThisWorkbook.Worksheets("TestMakro").Range("A3")