Macro rij kopieren en plakken in andere sheet

[lodewijk007]

Beste experts,

Ik zit met het volgende probleem. Ik wil dat in sheet (Waarden) de rij A27:E27 gekopieerd wordt met de datum die in sheet (Datum) cel B2 staat naar sheet (Uitkomst) in de cellen B2:F2.

Dus kort samengevat wil ik een macro die de rij kopieert die hoort bij de datum die is ingevoerd in sheet (Datum) en deze vervolgens kopieert in sheet (Uitkomst) B2:F2 en niet dus naar A2:E2. De datum moet ik dus kunnen aanpassen in de sheet (Datum) cel B2 zodat er weer een andere datum wordt gezocht en geplakt.

Hopelijk is het duidelijk wat ik bedoel.

Alvast hartelijk dank!!

 

[mvw64]

Misschien kan je er zo iets mee

 

[VenA]

Waarom niet met een formule als je toch de gegevens in hetzelfde bereik wil hebben?

De code van mvw64 een beetje ingekort

Sub test()
On Error GoTo Foutje
    With Sheets("Waarden")
        Sheets("uitkomst").Range("B2:F2") = .Cells(.Cells(1).CurrentRegion.Columns(1).Find(Sheets("Datum").Range("B2"), LookIn:=xlValues).Row, 1).Resize(1, 5).Value
    End With
    Exit Sub
Foutje:
MsgBox "De datum is niet gevonden"
End Sub

 

[HSV]

De foutafhandeling hoeft niet met "on error goto".

In bladmodule "datum" en de rest is vol automatisch.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Target.Address = "$B$2" And Target.Count = 1 Then
 Set c = Sheets("waarden").Columns(1).Find(Sheets("Datum").Range("B2"), , , xlWhole)
   If Not c Is Nothing Then
      Sheets("uitkomst").Range("B2:F2") = c.Resize(, 5).Value
  End If
 MsgBox IIf(c Is Nothing, "De datum is niet gevonden", "waarden weggeschreven"), , "Melding!"
End If
End Sub

 

[lodewijk007]

Hartelijk dank voor het meedenken. De code van mvw64 is goed. Het is beter om een macro te gebruiken omdat ik vanuit verschillende Excel bestanden werk. De drie verschillende sheets die ik gebruik moeten dus uiteindelijk drie verschillende Excel bestanden worden.

Ik krijg alleen niet voor elkaar om een andere datum in te voeren, want krijg dan telkens een foutmelding dat de datum niet bestaat terwijl deze wel voorkomt. Weten jullie waardoor dit komt?

Nogmaals super bedankt voor het meedenken!!!

 

[HSV]

Select en Selection zijn overbodig en vertragend zoals in de code van @mvw64.
Als de gezochte datum een andere opmaak heeft kan het zijn dat het niet wordt gevonden (gebruik dan i.p.v. xlvalues eens xlformulas)
Overigens zijn alle drie de reacties macrocodes.

 

[lodewijk007]

Hartelijk dank HSV. Het is me inderdaad gelukt door xlformulas te gebruiken i.p.v. xlvalues. Ik weet niet of ik een aanvulling op mijn eerste vraag hier mag stellen, nu jullie deze hebben opgelost.

Ik zou namelijk graag als aanvulling willen dat de eerste vijf opeenvolgende waarden worden gekopieerd naar de sheet (Uitkomst).

Als voorbeeld:

Datum 20-02-2015 (Sheet, Datum)
Vervolgens wil ik dat de 4 opeenvolgende datums + waarden en de datum 20-02-2015 + waarden opgezocht worden in sheet (Waarden).

Vervolgens wil ik dus dat de cellen B2:F6 in sheet (Uitkomst) gevuld worden met onderstaande gegevens:
20-2-2015 1 2 1 2
21-2-2015 1 2 1 2
22-2-2015 2 3 2 3
23-2-2015 1 2 1 2
24-2-2015 1 2 1 2

Wanneer er geen 4 opeenvolgende datums beschikbaar zijn moet er een foutmelding komen o.i.d.

Is dit mogelijk om in 1 macro te schrijven?

Hopelijk kunnen jullie me hier weer mee verder helpen.

 

[HSV]

Uiteraard is het zeer verstandig om hier eigenlijk verder te gaan.

Test het zo maar eens weer Lodewijk.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, i As Long
If Target.Address = "$B$2" And Target.Count = 1 Then
For i = 0 To 4
 Set c = Sheets("waarden").Columns(1).Find(Sheets("Datum").Range("B2") + i, , xlFormulas, xlWhole)
   If Not c Is Nothing Then
      Sheets("uitkomst").Range("B2").Offset(i).Resize(, 5) = c.Resize(, 5).Value
  End If
      MsgBox IIf(c Is Nothing, "De datum """ & Range("B2") + i & """ is niet gevonden", _
 "waarden weggeschreven van """ & Range("B2") + i & """"), , "Melding!"
    Next i
  End If
End Sub