Sub BijwerkenVoorraden5()
With Sheets("Voorraad")
.Unprotect "nep"
Range("H4:H489").Select
Selection.Copy
Range("O4:O489 ").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:=False
Range("O4:O489").Select
Selection.Copy
Range("P4:P489 ").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:=False
Range("Z4:Z489").Select
Selection.Copy
Range("AA4:AA489").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:=False
Range("AA4:AA489").Select
Selection.Copy
Range("AB4:AB489 ").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:=False
Range("AA4:AA489").Select
Application.CutCopyMode = False
Selection.FormulaR1C1 = ""
Columns("T:T").Select
Selection.Copy
Columns("U:U").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("S:S").Select
Selection.Copy
Columns("T:T").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("R:R").Select
Selection.Copy
Columns("S:S").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("R:R").Select
Application.CutCopyMode = False
Selection.ClearContents
Columns("AD:AD").Select
Selection.Copy
Columns("AE:AE").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("AC:AC").Select
Selection.Copy
Columns("AD:AD").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("AB:AB").Select
Selection.Copy
Columns("AC:AC").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("AB:AB").Select
Application.CutCopyMode = False
Selection.ClearContents
End With
Dim x As Long, i As Long
Dim kolom As Variant, c As Range, Bereik As Range 'kijk naar de voorraad
With Sheets("voorraad").Range("A1:L" & Sheets("voorraad").Cells(Rows.Count, 12).End(xlUp).Row)
For Each kolom In Array("E", "F") '1 voor 1 deze kolommen aflopen
On Error Resume Next
Set Bereik = Nothing: Set Bereik = .Columns(kolom).SpecialCells(xlConstants, xlNumbers) 'in die kolom alle niet-lege cel met een getal
On Error GoTo 0
If Not Bereik Is Nothing Then 'zijn er dergelijke cellen ?
For Each c In Bereik 'dan 1 voor 1 die cellen aflopen
If .Cells(c.Row, "H").HasFormula Then 'kijk of er in de G-cel een formule staat(normaal gezien wel !!!!)
.Cells(c.Row, "G") = .Cells(c.Row, "G").Value + .Cells(c.Row, "E").Value - .Cells(c.Row, "F").Value 'pas voorraad aan door toevoegen geleverde bestellingen en aftrekken verbruik
.Cells(c.Row, "E").Resize(, 2).ClearContents 'verwijder geleverde bestellingen en verbruiken
End If
Next
End If
Next
Range("E4").Select
End With
End Sub
Sub Bestellen5() 'Gemaakt door VenA bij "Helpmij.nl"
Dim sh As Object, r As Range
Application.ScreenUpdating = False
With Sheets("voorraad").Range("A1:L" & Sheets("voorraad").Cells(Rows.Count, 12).End(xlUp).Row)
For Each sh In Sheets(Array("A", "B", "C"))
sh.Unprotect "nep"
sh.Cells(3, 1).CurrentRegion.Offset(1).Clear
.AutoFilter 12, sh.Name
.AutoFilter 8, ">0"
If .Columns(12).SpecialCells(12).SpecialCells(2).Count > 1 Then Set r = Union(.Offset(1).Columns(1).Resize(, 3), .Offset(1).Columns(8))
If Not r Is Nothing Then r.Copy sh.[A4]
.AutoFilter
sh.Protect "nep"
Next sh
.Parent.Protect "nep"
End With
End Sub
