Makro zur suche der dritten Montage
29.07.2019 12:09:20
Robert
wie kann man diesen Code abändern, sodass ich die dates und anzahl der Felder unter dem jeweiligen Datum nicht mehr einzeln nach einander eingebe sondern, dass am Anfang die Abfrage nach Anzahl der Felder unter den dates die kopiert werden sollen kommt und dann automatisch die werte unter den 3ten Monatge jedes fortlaufenden Monats in der Kopfzeile der Tabelle im gleichen Stil gesucht und auf das andere sheet kopiert werden. Das ergebnis wäre eine Auflistung von Daten die unter den 3ten Montagen jedes Monats stehen.
Wäre sehr froh wenn jemand hierfür einen Ansatz hätte.
Option Explicit
Public Sub Datum_Suchen()
Dim rngFind As Range
Dim strDate As String
Dim a As Long, b As Long, c As Long
strDate = InputBox("Datum:", , CDate(Date))
If strDate = "" Then Exit Sub
a = Sheets("Spreads2").Cells(68, Columns.Count).End(xlToLeft).Column
Set rngFind = Sheets("Spreads2").Range(Cells(69, 1), Cells(69, a)).Find(strDate, LookIn:= _
xlFormulas)
If Not rngFind Is Nothing Then
b = InputBox("Wieviele Zeilen sollen kopiert werden?", "Zeilen", "1")
Sheets("Spreads2").Range(Cells(rngFind.Row, rngFind.Column), Cells(rngFind.Row + b, _
rngFind.Column)).Copy
If Sheets("Result").Range("A1") = "" Then
Sheets("Result").Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
c = Sheets("Result").Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("Result").Cells(1, c + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Else
MsgBox "Das Datum wurde nicht gefunden!"
End If
End Sub
Anzeige