Mutaties

[maikeldeckers]

hallo ik heb nu dit in in mijn sheet staan, maar ik zou graag willen dat hij het boven bijschrijft en niet onder kunnen jullie hij mee helpen


Sheets("Mutaties").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(Now, [R4].Value, [S4].Value, -[T4].Value)

 

[VenA]

Dit is speciaal voor de helderzienden onder ons?

With Sheets("Mutaties")
.rows(2).insert
.cells(2,1).resize(,4) = Array(Now, [R4].Value, [S4].Value, -[T4].Value)
End with

 

[maikeldeckers]

hallo bedankt voor u hulp maar helaas krijg ik het niet voor elkaar, hierbij de hele bestand

zodra ik dit aanpas naar wat u zij dan blijft hij een fout melding geven.

Sub Afboeken()
sCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

For Each cl In Range("C9:C160")
If cl <> "" Then
sq2 = cl.Offset(, -1).Value
With Sheets("Voorraad")
Set foundcell = .Range("A:A").Find(cl)
If Not foundcell Is Nothing Then
sq1 = .Range(foundcell.Address).Offset(, 3).Value
.Range(foundcell.Address).Offset(, 3).Value = sq1 - sq2
End If
End With
End If
Next
Application.Calculation = sCalc
Application.ScreenUpdating = True
Sheets("Mutaties").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(Now, [R4].Value, [S4].Value, -[T4].Value)
End Sub

 

[cow18]

op het eerste zicht lijkt het voorstel van VenA logisch, maar je hebt het niet meegenomen in je laatste repliek.
Zoiets zou het moeten zijn.
Anders moet je een bestandje in bijlage meesturen ...

Sub Afboeken()
   sCalc = Application.Calculation
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False

   For Each cl In Range("C9:C160")
      If cl <> "" Then
         sq2 = cl.Offset(, -1).Value
         With Sheets("Voorraad")
            Set foundcell = .Range("A:A").Find(cl)
            If Not foundcell Is Nothing Then
               sq1 = .Range(foundcell.Address).Offset(, 3).Value
               .Range(foundcell.Address).Offset(, 3).Value = sq1 - sq2
            End If
         End With
      End If
   Next
   Application.Calculation = sCalc
   Application.ScreenUpdating = True

   [COLOR="#FF0000"]With Sheets("Mutaties")
      .Rows(2).Insert
      .Cells(2, 1).Resize[SIZE=5]([/SIZE], 4) = Array(Now, [R4].Value, [S4].Value, -[T4].Value)
   End With[/COLOR]
End Sub

 

[maikeldeckers]

hoi super nu werkt het heel erg bedankt. nu zie ik alleen dat hij bij de werkomgeving wel gewoon onderaan bijschrijft dit zou ik dan ook graag boven aan hebben. sorry voor de vele vragen maar ik ben helaas nog niet zo thuis in het schrijven van een macro. als iemand mij hier ook nog mee kan helpen zou ik super tevreden zijn. alvast bedankt

 

[cow18]

er staat een macro "afboeken" in de bladmodule van "werkomgeving" en die hangt daar ook onder die knop "afboeken".
Daarnaast is er nog een macro "afboeken" in de gewone module "afboeken".
Drie keer raden welke macro er uitgevoerd wordt als je op die ene knop drukt ... .
Je gaat of die ene macro moeten aanpassen of de knop aan de andere macro moeten hangen.

 

[maikeldeckers]

cow 18 ja dat begrijp ik maar deze werkt iets anders vandaar dat ik dit niet kan overnemen. daarom mijn vraag ik weet namelijk niet hoe ik die moet aanpassen aangezien dit anders is als de andere afboeken knop

 

[cow18]

voor de macro onder de knop zou dit kunnen.
Die andere zou je beter een andere naam geven om niet te verwarren, bv. Afboeken2

Sub Afboeken()
   With Sheets("voorraad").Columns(1)
      .Find([B8], , xlValues, xlWhole).Offset(, 3) = .Find([B8], , xlValues, xlWhole).Offset(, 3) - [C8]
   End With
   Dim data(1 To 5)
   data(1) = Now                                 'tijdstip boeking
   data(2) = [B8].Value                          'artikelnr
   data(3) = [D3].Value
   data(4) = CDbl([C8].Value) * -1

   [COLOR="#FF0000"]With Sheets("Mutaties")                       'in dat werkblad
      .Rows(2).Insert                            'op 2e rij een rij invoegen
      .Range("A2").Resize(, UBound(data)).Value = data   'in die 2e rij dit dan wegschrijven
   End With[/COLOR]
End Sub