Cellen op bepaalde datum en tijd kopieren

[m33p]

Beste,

Ik zal de situatie proberen uit te leggen (hoop dat ik dit duidelijk genoeg doe):

Via een webquery worden gegevens over het aantal geproduceerde stuks van een webpagina in een Excelsheet geplaatst. Ik heb ingesteld dat deze webquery elke dag om 9:45, 12:30, 14:45 en 16:30 wordt vernieuwd.

Wanneer de query is vernieuwd moet ik op elk van bovengenoemde tijden het aantal stuks wat in cel B2 van het tabblad webquery staat handmatig in het tabblad 'invulblad' zetten (zie bijlage) . In dit tabblad heb ik per datum en per tijd een invulveld gemaakt waar ik deze in moeten komen.

Wat ik graag zou willen is dat wanneer het bijvoorbeeld donderdag 21-4-2016 12:30:01 is (net na het vernieuwen van de webquery) de waarde uit cel B2 van de webquery automatisch wordt gekopieerd en geplakt in het tabblad 'invulblad' in cel C2 (ZONDER TE VERANDEREN WANNEER QUERY WORDT VERNIEUWD). En wanneer het 14:45 is de vernieuwde waarde uit B2 in cel D2 van het invulblad wordt gezet. Voor de volgende dag moet het dus dezelfde cel zijn maar +1 rij enzovoorts...

Ik ben geen kei in VBA dus ik hoop dat iemand mij hiermee kan helpen!

Alvast bedankt!:thumb:

Groet Rick

 

[gast0660]

Hoi,
Zet deze code in een module

Sub dotchie_945()
Dim lastrow As Long
lastrow = Sheets("invulblad").Range("E" & Rows.Count).End(xlUp).Row
Cells(lastrow + 1, "B").Value = Sheets("webquery").Range("B2").Value
End Sub
Sub dotchie_1230()
Dim lastrow As Long
lastrow = Sheets("invulblad").Range("E" & Rows.Count).End(xlUp).Row
Cells(lastrow + 1, "C").Value = Sheets("webquery").Range("B2").Value
End Sub
Sub dotchie_1445()
Dim lastrow As Long
lastrow = Sheets("invulblad").Range("E" & Rows.Count).End(xlUp).Row
Cells(lastrow + 1, "D").Value = Sheets("webquery").Range("B2").Value
End Sub
Sub dotchie_1630()
Dim lastrow As Long
lastrow = Sheets("invulblad").Range("E" & Rows.Count).End(xlUp).Row
Cells(lastrow + 1, "E").Value = Sheets("webquery").Range("B2").Value
End Sub

Zet deze code onder This workbook

Private Sub Workbook_Open()
If Weekday(Now, vbMonday) < 6 Then
Application.OnTime TimeValue("09:45:00"), "dotchie_945"
If Weekday(Now, vbMonday) < 6 Then
Application.OnTime TimeValue("12:30:00"), "dotchie_1230"
If Weekday(Now, vbMonday) < 6 Then
Application.OnTime TimeValue("14:45:00"), "dotchie_1445"
If Weekday(Now, vbMonday) < 6 Then
Application.OnTime TimeValue("16:30:00"), "dotchie_1630"
End If
End If
End If
End If
End Sub

Deze code loopt van maandag tot en met vrijdag
Verander <6 naar <7 , dan loopt de code van maandag tot en met zaterdag
U vbtje in bijlage
Edit: welkom op dit forum

 

[m33p]

Beste Dotchie,

Bedankt voor je reactie, ik ga het zsm proberen, laat weten of het werkt!

Bedankt!

 

[m33p]

Dotchie,

Bedankt voor je tijd en moeite, zoals je hem hebt gemaakt is precies wat de bedoeling is!

Echter werkt hij nog niet helemaal als ik hem in het originele Excelbestand zet.
Y30 moet hier in C8, E8, G8 en I8 komen. Als ik code overneem krijg ik wel te zien dat hij op de gewenste tijden iets laadt, maar het aantal komt nog niet in de cel te staan.

Waarschijnlijk klein iets wat ik over het hoofd zie ^^. Zou je een vlugge blik kunnen werpen?

Bedankt!

Groet, Rick

Bekijk bijlage exceltest.xlsm

 

[gast0660]

Hoi,

Waarschijnlijk klein iets wat ik over het hoofd

ja, dat je in je echt bestand met een tabel werkt en in uw voorbeeldje niet. Daarom is het ook zo belangrijk om altijd een representatief vbtje te posten.
Hierbij de aangepaste codes
Onder This workbook(geen veranderingen)

Private Sub Workbook_Open()
If Weekday(Now, vbMonday) < 6 Then
Application.OnTime TimeValue("09:45:00"), "dotchie_945"
If Weekday(Now, vbMonday) < 6 Then
Application.OnTime TimeValue("12:30:00"), "dotchie_1230"
If Weekday(Now, vbMonday) < 6 Then
Application.OnTime TimeValue("14:45:00"), "dotchie_1445"
If Weekday(Now, vbMonday) < 6 Then
Application.OnTime TimeValue("16:30:00"), "dotchie_1630"
End If
End If
End If
End If
End Sub

In een module

Sub dotchie_945()
Dim lastrow As Long
lastrow = Sheets("Tijdenaantallen").Range("I:I").Find("*", _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(lastrow + 1, "C").Value = Sheets("webquery_aantallen").Range("Y30").Value
End Sub
Sub dotchie_1230()
Dim lastrow As Long
lastrow = Sheets("Tijdenaantallen").Range("I:I").Find("*", _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(lastrow + 1, "E").Value = Sheets("webquery_aantallen").Range("Y30").Value
End Sub
Sub dotchie_1445()
Dim lastrow As Long
lastrow = Sheets("Tijdenaantallen").Range("I:I").Find("*", _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(lastrow + 1, "G").Value = Sheets("webquery_aantallen").Range("Y30").Value
End Sub
Sub dotchie_1630()
Dim lastrow As Long
lastrow = Sheets("Tijdenaantallen").Range("I:I").Find("*", _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(lastrow + 1, "I").Value = Sheets("webquery_aantallen").Range("Y30").Value
End Sub

2 opmerkingen:
Als je vandaag wilt testen verander <6 in <7 want we zijn zaterdag
Als je maandag wilt starten met de code moet je zorgen dat de waardes in C,E,G en I van vrijdag zijn ingevuld anders pakt de code een verkeerde rij

 

[m33p]

Hij werkt, super bedankt!!

 

[gast0660]

Hoi,
Mooi zo:thumb:
Bedankt voor de feedback