VBA offerte database opschonen

[spaarie]

Beste helpers,

Ik zit met een probleem. Ik heb een offerte database gemaakt waar alle offertes op 1 tabblad komen behalve degene die gereed zijn. Deze project kunnen "gereed gemeld" worden op het tabblad offertes.

Nu wil ik graag dat als deze "gereed gemeld" worden de desbetreffende regel uit het tabblad "offertes" geknipd wordt en plakt om tabblad "gereed".
Ik ben bezig geweest, maar ik kom er simpelweg niet meer uit. Ik zit vast op het stukje dat hij het project moet vinden vervolgens moet knippen en op de eerstvolgende lege regel plakken op tabblad gereed.

Wie wilt een blikje werpen?

 

[Niels28]

Set c = ws.Range("A3:A500").Find(project, LookIn:=xlValues, lookat:=xlWhole)
c.EntireRow.Cut Sheets("gereed").Rows(Sheets("gereed").Cells(Rows.Count, "A").End(xlUp).Row + 1)
c.EntireRow.Delete shift:=xlUp

Niels

 

[spaarie]

Wie anders dan Niels ... bedankt voor je reactie! Het werkt, maar het alleen een Copy van gemaakt ipv cut

Is het mogelijk dat als datum gereed wordt ingevuld deze in kolom K komt bij gereed?

 

[Niels28]

Set c = ws.Range("A3:A500").Find(project, LookIn:=xlValues, lookat:=xlWhole)
c.Offset(0, 10).Value = CDate(Date)
c.EntireRow.Copy Sheets("gereed").Rows(Sheets("gereed").Cells(Rows.Count, "A").End(xlUp).Row + 1)
c.EntireRow.Delete shift:=xlUp

Niels

 

[spaarie]

Top! Nog 1 dingetje
Ik heb zojuist me blad gereed beveiligd met 0000 nu plaats ik

with sheets("gereed")
.Protect Password:="0000", UserInterfaceOnly:=True

maar hij blijft de foutmelding geven... waar plaats ik de protect password?

 

[Warme bakkertje]

with sheets("gereed")
.UnProtect Password:="0000"
..........code
.Protect Password:="0000", UserInterfaceOnly:=True
end with

 

[spaarie]

Rudi,
Hij geeft een foutmelding op de .Unprotect etc, etc. Dit is mijn huidige code:

Private Sub meldgereed_Click()
Dim ws As Worksheet
Set ws = Worksheets("OFFERTES")
If project = "" Then
MsgBox ("U heeft nog geen project ingevuld, maak een keuze uit een project en probeer het opnieuw.")
project.SetFocus
Exit Sub
End If
Answer = MsgBox("Weet u zeker dat u het project " & project & " gereed wilt melden?", vbQuestion + vbYesNo, "Waarschuwing")
If Answer = vbNo Then
Me.project.Value = ""
Me.titel.Value = ""
project.SetFocus
End If
With Sheets("GEREED")
.[COLOR="#FF0000"]Unprotect Password:="0000", UserInterfaceOnly:=True[/COLOR]
Set c = ws.Range("A3:A500").Find(project, LookIn:=xlValues, lookat:=xlWhole)
c.Offset(0, 10).Value = CDate(Date)
c.EntireRow.Copy Sheets("gereed").Rows(Sheets("gereed").Cells(Rows.Count, "A").End(xlUp).Row + 1)
c.EntireRow.Delete shift:=xlUp
.Protect Password:="0000", UserInterfaceOnly:=True
Unload Me
End With
End Sub

 

[Warme bakkertje]

.Unprotect Password:="0000"

 

[spaarie]

Oeps! :d
Maar krijg ik een foutmelding bij

.Unprotect Password:="0000"
Set c = ws.Range("A3:A500").Find(project, LookIn:=xlValues, lookat:=xlWhole)
[COLOR="#FF0000"]c.Offset(0, 10).Value = CDate(Date)[/COLOR]
c.EntireRow.Copy Sheets("gereed").Rows(Sheets("gereed").Cells(Rows.Count, "A").End(xlUp).Row + 1)
c.EntireRow.Delete shift:=xlUp
.Protect Password:="0000", UserInterfaceOnly:=True

 

[spaarie]

Gefixt! Misschien heel omslachtig, maar hij doet het

With ws
.Unprotect Password:="0000"
With Sheets("GEREED")
.Unprotect Password:="0000"
Set c = ws.Range("A3:A500").Find(project, LookIn:=xlValues, lookat:=xlWhole)
c.Offset(0, 10).Value = CDate(Date)
c.EntireRow.Copy Sheets("GEREED").Rows(Sheets("GEREED").Cells(Rows.Count, "A").End(xlUp).Row + 1)
c.EntireRow.Delete shift:=xlUp
.Protect Password:="0000", UserInterfaceOnly:=True
With ws
.Protect Password:="0000", UserInterfaceOnly:=True
Unload Me
End With
End With
End With
End Sub

 

[spaarie]

Heren,
Ik heb nu de code gekopieerd voor een ander tabblad en hier en daar aangepast, maar nu krijg ik een foutmelding op de volgende regel:

With ws
.Unprotect Password:="0000"
With Sheets("OPDRACHTENLIJST")
.Unprotect Password:="0000"
Set c = ws.Range("A3:A500").Find(project, LookIn:=xlValues, lookat:=xlWhole)
c.Offset(0, 8).Value = CDate(Date)
c.Offset(0, 15).Value = bedrag.Value
c.Offset(0, 16).Value = uren.Value
[COLOR="#FF0000"]c.EntireRow.Copy Sheets("OPDRACHTENLIJST").Rows(Sheets("ODPRACHTENLIJST").Cells(Rows.Count, "A").End(xlUp).Row + 1)[/COLOR]
.Protect Password:="0000", UserInterfaceOnly:=True
With ws
.Protect Password:="0000", UserInterfaceOnly:=True
Unload Me
End With
End With
End With
End Sub

En dit is de orginele die werkt!

With ws
.Unprotect Password:="0000"
With Sheets("GEREED")
.Unprotect Password:="0000"
Set c = ws.Range("A3:A500").Find(project, LookIn:=xlValues, lookat:=xlWhole)
c.Offset(0, 10).Value = CDate(Date)
c.EntireRow.Copy Sheets("GEREED").Rows(Sheets("GEREED").Cells(Rows.Count, "A").End(xlUp).Row + 1)
c.EntireRow.Delete shift:=xlUp
.Protect Password:="0000", UserInterfaceOnly:=True
With ws
.Protect Password:="0000", UserInterfaceOnly:=True
Unload Me
End With
End With
End With
End Sub

Wat moet ik nog aanpassen???

 

[spaarie]

NEVER MIND! IK ZIE DE FOUT!

Als je Odprachtenlijst typt werkt het ook niet