• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Datum en tijd kopieren

Status
Niet open voor verdere reacties.
S

sloekie

Gebruiker
Lid geworden
7 apr 2008
Berichten
221
Hallo allen

wie kan mij helpen ik heb al gezocht op de forum en het net maar kon het niet vinden.
ik wil graag de datum en tijd kopieren 1 voor 1 (blad1 H2 t/m h30)naar blad2 maar zo dat deze in een cel komt te staan naast die van de datum. dus in de kolom waar behandeltijd in staat en daar onder. dus hij moet altijd kijken waar als het heen wordt gekopieerd dus datum bij datum.
en kan hij dit blijven doen als de datum wordt veranderd in blad2 G1 want dan wijzigt de hele rij mee.

zie bijlage.
Alvast hartelijk dank.

Gr Sloekie
 

Bijlagen

Probeer deze code eens.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cl As Variant
       For Each cl In Range("H2:H30")
         If cl > 0 Then
       kol = Application.WorksheetFunction.Match(CLng(cl), Sheets("Blad2").Rows(1), 0)
    With Sheets("Blad2").Cells(Rows.Count, kol + 1).End(xlUp)
        .Offset(1) = cl
        .Offset(1).NumberFormat = "dd-mm-yyyy  hh:mm"
      End With
     End If
   Next
 Sheets("Blad2").Columns.AutoFit
End Sub
 
Laatst bewerkt:
Hallo HSV

hoe krijg ik nu de gegevens uit blad1 rij H vandaan dan?
want hij haalt het nu uit blad2 rij H

gr. sloekie
 
Zet de code in moduleblad van Blad1.
Ik heb het met een change-event gedaan (vorige post aangepast) maar het kan wel anders.
 
Beste HSV

het werkt maar zet ik er nog meerdere datums in blad1 dan kopieert hij ze allemaal mee en dat moet niet
hij moet alleen die kopieren waar op geklikt wordt zou dat ook kunnen?

:thumb::thumb::d

Gr. Sloekie
 
Probeer het zo eens.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("H2:H30")) Is Nothing Then
         If Target.Value > 0 Then
       kol = Application.WorksheetFunction.Match(CLng(Target.Value), Sheets("Blad2").Rows(1), 0)
    With Sheets("Blad2").Cells(Rows.Count, kol + 1).End(xlUp)
        .Offset(1) = Target.Value
        .Offset(1).NumberFormat = "dd-mm-yyyy  hh:mm"
      End With
    End If
  Sheets("Blad2").Columns.AutoFit
  End If
End Sub
 
Laatst bewerkt:
Hallo HSV

hij geeft foutmelding aan: Fout 424 tijdens uitvoering: object vereist
dit is wat dan geel is: If Not Intersect(Target, Range("H2:H30")) Is Nothing Then

wat is hier fout dan?

gr.Sloekie
 
Geen idee, bij mij werkt het perfect als je iets invult in het bereik.

Het kan ook met een dubbelklik op de cel.
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
......code
End Sub
 
Laatst bewerkt:
Zoals Harry al aangaf
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("H2:H30")) Is Nothing Then
         If Target.Value > 0 Then
       kol = Application.WorksheetFunction.Match(CLng(Target.Value), Sheets("Blad2").Rows(1), 0)
    With Sheets("Blad2").Cells(Rows.Count, kol - 1).End(xlUp)
        .Offset(1) = Format(Target.Value, "dd/mm/yy h:mm")
    End With
    End If
  Sheets("Blad2").Columns.AutoFit
  End If
End Sub
Plaats deze in de bladmodule van je werkblad met de gegevens. Door nu te dubbelklikken op een datunm wordt deze gekopieërd.
 
Hallo heren

sorry voor de late reactie moest afgelopen nacht ineens werken.
de code werkt maar hij zet de datum niet bij de datum en behandelstap al is gekeken of ik het veranderen kon maar dan gaf hij steeds een foutmelding.
zou het ook mogelijk zijn dat de code bij de code kan van het kopieeren naar blad 2
ik heb een knop gemaakt hiervoor
zie bijlage

Gr. Sloekie
 

Bijlagen

Probeer het zo eens.
Code: 
Private Sub Kopieerennaarblad2_Click()
 If ActiveCell.Column <> 1 Then Exit Sub                  'niet dubbelgelklikt in de 1e kolom
     ActiveSheet.Unprotect
  If MsgBox("Datum en tijd ingevoerd ?", vbYesNo) = vbNo Then Exit Sub ' the macro ends if the user selects the CANCEL-button
      With Sheets("blad2")
       .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 6).Value _
       = ActiveCell.Resize(, 6).Value 'kopieer de ganse rij naar eerstvolgende lege rij in blad4
 kol = Application.WorksheetFunction.Match(CLng(ActiveCell.Offset(, 7).Value), Sheets("Blad2").Rows(1), 0)
       .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, kol).Resize(, 22).Value _
    = ActiveCell.Offset(, 6).Resize(, 22).Value
        .Columns.AutoFit
      End With
     MsgBox "Rij " & ActiveCell.Row & " is gekopieerd"
    Exit Sub                                                 'stop hier als rij niet verwijderd moet worden, wil je die rij wel weg, verwijder dan deze rij in de macro
  ActiveSheet.Unprotect
     ActiveCell.EntireRow.Delete Shift:=xlUp                 'wis deze rij
       ActiveSheet.Protect
End Sub
 
Hallo Harry

dit werkt geweldig.:thumb::thumb::thumb:

maar nu wil ik de code naar een andere exelbestand kopieeren moet ik dan toch alleen de sheets veranderen in bv voorraad of moet er nog meer veranderd worden.

Gr. Sloekie:o
 
Er moet nog meer veranderd worden.
Het bestand openen vanaf de schijf en map waar die staat, wegschrijven en weer sluiten.

Zoek hier eens op het forum naar, 'naar gesloten bestand wegschrijven'.
 
Hallo Harry

hij werkt perfect in het andere bestand maar ik heb het ook gekopieert naar nog een bestand
ik zou hem daar ook willen gebruiken in een werkblad met de naam voorraad maar als ik dit in de code verander krijg ik een foutmelding: eigenschap match van klasse worksheetfunction kan niet worden opgehaald, dus wat moet ik verder hier nog veranderen
en dit staat in geel: kol = Application.WorksheetFunction.Match(CLng(ActiveCell.Offset(, 7).Value), Sheets("voorraad").Rows(1), 0)
dat andere zal ik zoeken op forum

Gr.Sloekie
 
Hallo Sloekie,

Ik vermoed dat de gezochte datum niet in rij 1 staat.
 
Hallo Harry

ik heb het gevonden de aantal rijen stond op 1 deze op 3 gezet en hij doet het en zou het ook met meerdere datums kunnen zeg maar h1 t/m am1 want ongeveer bij behandelstap p5 zag ik dat de datum niet klopt omdat deze een dag verspringt dit had ik niet zo gauw gezien.
alvast bedankt.

Gr. Sloekie:o:o
 
Als ik je vraag begrijp.
In de code staat resize(, 22), maak daar 33 van
 
Harry

deze heb ik op alle 2 op 33 gezet of moest er maar 1 van de 2 zijn.
ik zal er een bijlage bij doen dan kun je zien waar hij de datum verkeerd neer zet hij doet het bij 25-04-2011 en zo verder.

sloekie
 

Bijlagen

De code neemt de hele rij over.
Als dit altijd 3 dagen meer is i.p.v. 2, is het misschien een optie om 2 kolommen in te voegen op Kolom V van Blad 1 (groen gemarkeerd).
 

Bijlagen

dit zou ik vanaf deze kolommen bij de andere kolommen ook moeten doen
maar dan heb ik een probleem toch dat hij niet alle gegevens meeneemt omdat het bereik van het aantal kolommen meer wordt. moet je dan weer iets aanpassen dan in de code. of kan dit zo blijven



gr. sloekie
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan