Ich habe folgenden Code um ein Name zu suchen und dann zu kopieren.
Option Explicit
Sub MultiSeek()
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
tarWks = "Tabelle2" 'Name_der_Zieltabelle
Cr = 65536
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
If Cr = 0 Then Cr = 1
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
If wks.Name = tarWks Then GoTo Exitfor
Set rng = wks.Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Exitfor:
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub
Ich möchte nun ,dass Excel - (auch per Userform mit Textbox oder Combobox wie es am besten ist)- das aktuelle Datum abfragt und den Namen in das enstprechende Blatt kopiert. Die Blätter sind nach Datum benannt.
Vielen Dank im voraus für eurer Hilfe