Regel automatische verplaatsen naar ander werkblad

[svdklein]

Beste alle,

Ik heb een vraagje over een formulier die ik aan het maken ben voor mijn werk,

Ik heb een formulier gemaakt zodat we kunnen zien welke adressen er leeg komen en die verhuurd zijn met alle tussen proccessen er in. Maar nu zou ik graag willen dat een cel een bepaalde (datum van vandaag) datum heeft bereikt automatische naar het werkblad verhuurd komt.

Maar ik heb geen idee hoe macro's werken enzo,

Alvast bedankt,

 

[HSV]

Zo zou het kunnen.

Zet deze in Thisworkbook en opslaan (in een testbestandje).
Er van uitgaande dat de data vandaag zich in kolom A bevindt.
Elke keer als je het bestandje opent worden de rijen gekopieerd naar blad2, en op blad1 gewist.

Private Sub Workbook_Open()
Dim c
For Each c In [A1:A65536]
      If c = Date Then
         c.EntireRow.Copy Sheets(2).[A65536].End(xlUp).Offset(1)
         c.EntireRow.Delete
    On Error Resume Next
  End If
Next
End Sub

 

[svdklein]

Beste Harry,

Waar moet ik dat tekst bestandje exact plaatsen.
Zou u kolom A kunnen aanpassen in kolom M, als het makkelijker is kan ik ook het bestandje mee sturen?

Alvast bedankt,

 

[Warme bakkertje]

Zo kan het ook.

Private Sub Worksheet_Deactivate()
On Error Resume Next
  Do
    With Sheets("Blad1").Columns(13).Find(Date, , xlValues, xlWhole).EntireRow
       If Err.Number > 0 Then Exit Sub
       Sheets("Verhuurd").Cells(Rows.Count, 1).End(xlUp).Offset(1).EntireRow = .Value
      .Delete
    End With
  Loop
End Sub

Rechtsklik op de bladtab met je verzamellijst en selecteer Programmacode weergeven. Plak in dit venster dan de code. Kijk goed na of de bladnamen overeenkomen. Bij het verlaten van het blad worden alle gegevens verplaatst naar blad Verhuurd.

 

[HSV]

Met een kleine aanpassing; als de laatste rij in kolom A niet gevuld is herschrijft het de vorige.

Private Sub Worksheet_Deactivate()
On Error Resume Next
  Do
    With Sheets("Blad1").Columns(13).Find(Date, , xlValues, xlWhole).EntireRow
       If Err.Number > 0 Then Exit Sub
       Sheets("Verhuurd").Cells(Rows.Count, 1[COLOR="red"][B][COLOR="red"][SIZE="2"]3[/SIZE][/COLOR][/B][/COLOR]).End(xlUp).Offset(1).EntireRow = .Value
      .Delete
    End With
  Loop
End Sub

 

[svdklein]

Nou ik heb beide bestandjes geprobeerd,

Helaas werkt het niet!

Help,

 

[HSV]

Nou ik heb beide bestandjes geprobeerd,

Helaas werkt het niet!

Help,

Bij mij wel.

 

[Warme bakkertje]

Jij kan helpen door een voorbeeldbestandje te posten met enkele regels gegevens (niet gevoelige info) zodat wij kunnen zien waar je verkeerd loopt, want bij mijn test liep het gesmeerd

 

[svdklein]

Het werk alleen als ik mijn eigen schema kopieerd dan werkt het niet meer, mischien omdat er in mijn blad nog wat codes staan. Ik heb mijn schema toegevoegd,

 

[HSV]

Hierbij je bestandje.

Zet de opmaak van Verhuurschema kolom M op Datum, i.p.v. Aangepast.

 

[danny147]

Beste svdklein

Aangepast op kolom M

Groetjes Danny. :thumb:

 

[svdklein]

Ontzettend bedankt! :thumb: Het werk inderdaadt,

Groetjes..

 

[HSV]

Niet vergeten als opgelost te zetten.
Bvd.

 

[svdklein]

Na de eerste dag! Er zijn toch problemen, na het kopieren van de adres gegevens werkt het niet meer. En regel 4 werkt helemaal niet. Mischien is het een optie om een knop te maken. Zodat je handmatig kan verplaatsen.

Ik hoop op een reactie,

 

[Warme bakkertje]

Nou, dit werkt voor mij toch voorbeeldig. Er wordt gekeken naar de datum in cel A1 en bij het verlaten v/h blad worden de juiste regels weggeschreven en verwijderd.

 

[svdklein]

Mischien is dat het probleem, het gaat namelijk om cel M4 t/m.... In eerste instantie werkte het ook,

 

[Warme bakkertje]

In A1 staat steeds de datum van vandaag dus elke cel in kolom M die overeenkomt met A1 wordt steeds weggeschreven als een ander blad geselcteerd wordt. Ik zie niet waar het probleem dan kan zitten. Heb je eigenlijk alles in je origineel al eens vergeleken met het laatste voorbeeldbestand ?

 

[HSV]

Helaas doe je laatst geplaatst bestandje het niet Rudi.

With Sheets("verhuurschema").Columns(13).Find([COLOR="red"]Format([A1], "dd/mm/yy"), [/COLOR], xlValues, xlWhole).EntireRow

Met onderstaande werkt het wel, maar moet ook de opmaak op 'Datum' staan en niet op aangepast: "dd-mm-jj"

With Sheets("verhuurschema").Columns(13).Find([A1], , xlValues, xlWhole).EntireRow

Misschien kun je er even naar kijken.

 

[Warme bakkertje]

Toch wel, kijk maar eens in de celeigenschappen Aangepast: dd/mm/jj
Als je blad verhuurd 2010 selecteerd wordt alles verplaatst

 

[HSV]

Helaas Rudi, de rijen verplaatsen niet bij mij.
Ik heb het bestand even opgeslagen en heropend, maar werkt ook niet.
Heb je nog andere suggesties waarom het door jouw laatst geplaatst bestandje niet werkt bij mij?