Private Sub Rijkopieren_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
[COLOR="red"]Application.EnableEvents = False[/COLOR]
With Sheets("voorraad")
.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
End With
Dim cl As Variant
Y = 7
For Each cl In Sheets("behandelschema").Range(Cells(ActiveCell.Row, Y), Cells(ActiveCell.Row, 174))
If cl <> "" Then
With Sheets("voorraad")
On Error Resume Next
kol = Application.WorksheetFunction.Match(CLng(DateValue(Cells(ActiveCell.Row, Y + 1).Value)), Sheets("voorraad").Rows(3), 0)
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, kol + 1).Value _
= Cells(ActiveCell.Row, Y).Value
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, kol).Value _
= Cells(ActiveCell.Row, Y - 1).Value
On Error GoTo 0
End With
End If
Y = Y + 1
Next
Sheets("Voorraad").Cells(Rows.Count, "IO").End(xlUp).Offset(1) = Cells(ActiveCell.Row, 8)
Sheets("voorraad").Columns.AutoFit
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
[COLOR="red"]Application.EnableEvents = True[/COLOR]
ActiveSheet.Protect
End Sub