Guten Abend,
ich arbeite momentan an einem Makro. Die Idee ist, dass dieses Makro die neueste Datei (wird im bestimmten Ordner abgelegt) öffnet und dort nach dem Wert sucht (sagen wir "Blumen"). Danach geht es in die andere Spalte und kopierte den dortigen Zahlwert. Und so bis alle Zahlen mit "Blumen" kopiert und addiert in meine Datei eingefügt wurden.
So sieht momentan mein Makro aus. Leider hört es entweder schon bei dem ersten Wert auf oder kopiert nur den letzten. :( Ich bedanke mich im Voraus für jegliche Hilfe!
Sub Open_All()
Const StrPath As String = "Pfad"
Dim strFile As String, strFile2open As String, dteFile As Date, dteLast As Date
strFile = Dir$(StrPath & "*.xl*")
If strFile <> "" Then
Do
dteFile = FileDateTime(StrPath & strFile)
If dteFile > dteLast Then
strFile2open = strFile
dteLast = dteFile
End If
strFile = Dir$
Loop Until strFile = ""
Workbooks.Open StrPath & strFile2open
Else
MsgBox "Keine Datei gefunden!"
End If
Do Until Range("A1:A100") = "Ende"
For Each Cell In Range("F1:F100")
If Cell.Value = "Blumen" Then
Cell.Offset(0, 8).Copy
End If
Next
End If
Loop
Windows("Meine Datei").Activate
Range("D15").PasteSpecial = 2
End Sub
|