Met Appli.Ontime celinhoud kopieeren

[Antonius100]

Goedemorgen allen.

Graag wil ik middels de Application.OnTime Now functie op een bepaald tijdstip informatie uit een sheet naar een andere sheet kopieeren.
in This workbook komt te staan Application.OnTime TimeValue("18:15:00"), "Kopie"
en voor het kopieren van de celinhoud heb ik een deel van de macro al gemaakt.
De reden voor deze macro is dat de inhoud van de cel verandert, maar deze informatie die om 18:15 in de cel staat moet naar een andere sheet gekopieerd worden.

Option Explicit

Sub Kopie()
Dim ws As Worksheet, NewRow As Integer
Set ws = Sheets("Sheetnaam")
NewRow = ws.Range("G" & Rows.Count).End(xlUp).Row + 1
ws.Range ("G" & NewRow)Copy Range("D3")
.Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
End Sub

Dit is de code tot nu toe.
Misschien dat jullie mij hierbij een handje kunnen helpen.

Het principe lijkt omdat van onderstaande link. Echter is de bedoeling dat nu in plaats van de datum, de celinhoud gekopieerd word achter die datum.

http://www.helpmij.nl/forum/showthread.php?t=390488

Met vriendelijke groet,

Teun Bogaerts

 

[snb]

In plaats van ontime kun je in het kopieblad een querytabel, die naar het gegevensblad verwijst, zetten met een door jou gewenste verversingsfrekwentie.

Mij is niet duidelijk wat waarheen gekopieerd moet worden in jouw code.
Wat zou kunnen werken is

Sub Kopie()
  activesheet.range(D3").copy sheets("sheetnaaam").cells(rows.count,7).end(xlup).offset(1)
End Sub

 

[Warme bakkertje]

Teun, in bijlage een werkend voorbeeldje. Pas de uren aan, sla op en heropen

Mvg

Rudi

 

[Antonius100]

Teun, in bijlage een werkend voorbeeldje. Pas de uren aan, sla op en heropen

Mvg

Rudi

Goedemorgen Rudi,
Je hebt me al een heel eind op weg geholpen, Echt mijn dank hiervoor.
Deels werkt de macro. Dat is al heel fijn.
Nu rest mij nog 1 vraag.
De bedoeling is om de celinhoud met Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats ( dus alleen waarden en getalnotaties plakken )
van Blad1 ( hij staat in D3 ) naar Blad2 naar cel G3 te kopieeren en vanaf daar dus naar onder laat maar zeggen.
Enig idee hoe ik dit moet doen ?
Alvast super bedankt voor je hulp, ik stel het echt op prijs.

Met vriendelijke groet,

Teun

 

[Warme bakkertje]

Teun, zoals gevraagd. G1 en G2 mogen echter niet leeg zijn !

Option Explicit

Sub Datum_Plaatsen()
Application.OnTime TimeValue("12:25:00"), "Datum_Plaatsen"
Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Offset(1).FormulaR1C1 = Date
End Sub

Sub Kopie()
    Application.OnTime TimeValue("12:25:15"), "Kopie"
        Sheets("Blad1").[D3].Copy
        Sheets("Blad2").Cells(Rows.Count, 7).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
End Sub

Mvg

Rudi

 

[Antonius100]

Teun, zoals gevraagd. G1 en G2 mogen echter niet leeg zijn !

Option Explicit

Sub Datum_Plaatsen()
Application.OnTime TimeValue("12:25:00"), "Datum_Plaatsen"
Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Offset(1).FormulaR1C1 = Date
End Sub

Sub Kopie()
    Application.OnTime TimeValue("12:25:15"), "Kopie"
        Sheets("Blad1").[D3].Copy
        Sheets("Blad2").Cells(Rows.Count, 7).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
End Sub

Mvg

Rudi

Hallo Rudi,

het is een beetje een late reactie, maar dat terzijde.
Ik wil je heel erg bedanken voor je reactie, want dit is precies wat ik bedoelde.

Ik zal ermee aan het werk gaan en nogmaals heel erg bedankt.

Met vriendelijke groet,

Teun