• 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.

data wegschrijven naar een extern blad in een specifiek veld plaatsen

Status
Niet open voor verdere reacties.
R

rogersmeets

Gebruiker
Lid geworden
6 apr 2023
Berichten
74
Hoi ik schrijf in het blad teamleider produktie dachboard de gemaakte karren die we invullen in de witten vakken, ik wil graag met een druk op de knop opslaan dat deze worden weggeschreven in het blad jaarproductie Aantal m3_element.
Daar wil ik graag dat ze worden weggeschreven in het vak waar de juiste waarden van stenen staan dus : 120/643/CS20 van het 1e formulier naar het 2e in de juiste cel met data.

Dit is de code die nu in de macro staat voor de andere gegevens die hij weg schrijft;
Code: 
Sub Button2_Click()
Set sh = Sheets("Teamleider-Productie Dashboard")
With Sheets("Jaarproductie-aantal karren")
  r = Application.Match(sh.Range("e37"), .Columns(2), 0)
  If IsNumeric(r) Then
         .Cells(r, 3).Resize(, 7).Value = sh.Range("f37:l37", "n40").Value
        
         For Each cl In .Cells(r, 3).Resize(, 7)
           cl.Interior.ColorIndex = sh.Range("f37").Offset(, y).DisplayFormat.Interior.ColorIndex
            y = y + 1
         Next cl
    
        MsgBox "Data gekopieerd naar aantal karren !", vbInformation, "Copy"
 
  End If

End With

With Sheets("Jaarproductie-aantal m3)")
  r = Application.Match(sh.Range("e37"), .Columns(2), 0)
  If IsNumeric(r) Then
         .Cells(r, 3).Resize(, 7).Value = sh.Range("f38:m38").Value
        
         For Each cl In .Cells(r, 3).Resize(, 7)
           cl.Interior.ColorIndex = sh.Range("f38").Offset(, y).DisplayFormat.Interior.ColorIndex
            y = y + 1
         Next cl
    
        MsgBox "Data gekopieerd naar aantal m3!", vbInformation, "Copy"
 
  End If

End With
End Sub




Tevens werkt het onderste stuk van de code maar schrijft hij "n40" niet meer weg dat is het aantal gehaalde targets waar ligt dat aan ?

Code: 
Sub Button2_Click()
Set sh = Sheets("Teamleider-Productie Dashboard")
With Sheets("Jaarproductie-aantal karren")
  r = Application.Match(sh.Range("e37"), .Columns(2), 0)
  If IsNumeric(r) Then
         .Cells(r, 3).Resize(, 7).Value = sh.Range("f37:l37", "n40").Value
        
         For Each cl In .Cells(r, 3).Resize(, 7)
           cl.Interior.ColorIndex = sh.Range("f37").Offset(, y).DisplayFormat.Interior.ColorIndex
            y = y + 1
         Next cl
    
        MsgBox "Data gekopieerd naar aantal karren !", vbInformation, "Copy"
 
  End If


Ve=
Nu schrijft
 

Bijlagen

zo?
Code: 
.Cells(r, 3).Resize(, 7).Value = sh.Range("f37:l37").Value
.Cells(r, 11) = sh.Range("N40").Value
 
yes perfect thanks

en als ik nu in het laatste blad de aantallen elemeten wil laten wegschrijven bij het juiste element hoe gaat dat ?
 
Zo ? , je moet zelf maar eens uitpluizen waarom met regelmaat de MsgBox verschijnt.
Code: 
Sub verwerk()
Dim zoek As String, rng As Range, c
Set sh = Sheets("Teamleider-Productie Dashboard")

For Each ct In sh.Range("K27:K33, P27:P33, U27:U33")
 zoek = ct.Offset(, -4) & "/" & ct.Offset(, -3) & "--" & ct.Offset(, -2)
 
    Set c = Sheets("Jaarproductie Aantal m3_Element").UsedRange.Find(zoek, lookat:=xlWhole)
        If Not c Is Nothing Then
            c.Offset(, 1).Value = c.Offset(, 1).Value + ct.Value
     
        Else
            MsgBox "element  " & zoek & "  niet gevonden in blad Jaarproductie Aantal m3_element"
        End If
Next ct
End Sub
 
Zet de karren en de kubiek meters in 1 database.
Laat Excel vervolgens het werkvoor je doen met draaitabel en draaitabelgrafiek.
 
AD1957 zei:
Zo ? , je moet zelf maar eens uitpluizen waarom met regelmaat de MsgBox verschijnt.
Code: 
Sub verwerk()
Dim zoek As String, rng As Range, c
Set sh = Sheets("Teamleider-Productie Dashboard")

For Each ct In sh.Range("K27:K33, P27:P33, U27:U33")
 zoek = ct.Offset(, -4) & "/" & ct.Offset(, -3) & "--" & ct.Offset(, -2)
 
    Set c = Sheets("Jaarproductie Aantal m3_Element").UsedRange.Find(zoek, lookat:=xlWhole)
        If Not c Is Nothing Then
            c.Offset(, 1).Value = c.Offset(, 1).Value + ct.Value
    
        Else
            MsgBox "element  " & zoek & "  niet gevonden in blad Jaarproductie Aantal m3_element"
        End If
Next ct
End Sub
Klik om te vergroten...
Hij kopieert nu wat er naartoe super thanks
alleen kopieert hij van een cel te ver, hij moet de witte cellen met karren aantal kopieren alleen moet ik dat vermenigvuldigen straks met het aantal stenen op een kar.

hij ziet nog niet het verschil tussen onderstaande stenen, dit zijn 3 aparte stenen die ook apart in de kolom op dat blad staan, ik denk iets met die offset maar hoe dat werkt ???
je hebt er (-2)bij die offset staan waar staat dat voor ?

150/643--CS20
150/643--CS20---24X
150/643--CS20---16x (pall)
 

Bijlagen

Zorg dat je dit stukje van de code begrijpt, dan wordt het een stuk duidelijker.
Code: 
For Each ct In sh.Range("K27:K33, P27:P33, U27:U33")
 zoek = ct.Offset(, -4) & "/" & ct.Offset(, -3) & "--" & ct.Offset(, -2)
ct.offset(,-2) betekent 2 cellen naar links
ct.offset(1,-2) betekent 1 cel naar onder twee naar links. (gebruik google of zoek op helpmij wat offset doet.
Dat sommige stenen niet gevonden worden ligt eraan dat de gegevensvensvalidatie niet overkomt met
de samengestelde gegevens op het blad Jaarproductie Aantal m3_Element. Kijk eens naar de --------
geen of twee of drie streepjes.
De msgbox had ik niet voor niets in code gezet.
 
AD1957 zei:
Zorg dat je dit stukje van de code begrijpt, dan wordt het een stuk duidelijker.
Code: 
For Each ct In sh.Range("K27:K33, P27:P33, U27:U33")
 zoek = ct.Offset(, -4) & "/" & ct.Offset(, -3) & "--" & ct.Offset(, -2)
ct.offset(,-2) betekent 2 cellen naar links
ct.offset(1,-2) betekent 1 cel naar onder twee naar links. (gebruik google of zoek op helpmij wat offset doet.
Dat sommige stenen niet gevonden worden ligt eraan dat de gegevensvensvalidatie niet overkomt met
de samengestelde gegevens op het blad Jaarproductie Aantal m3_Element. Kijk eens naar de --------
geen of twee of drie streepjes.
De msgbox had ik niet voor niets in code gezet.
Klik om te vergroten...
Kan het zijn dat bij de 2e keer schrijven een dag later hij hetr niet meer registreert.

Ik ben aan het testen met de voorwaarden gelijk te maken maar bij de 2e keer iets ernaar toe schrijven komt er niets meer.
 
Code: 
Sub Button2_Click()
Set sh = Sheets("Teamleider-Productie Dashboard")
With Sheets("Jaarproductie Karren 2023")
  r = Application.Match(sh.Range("e37"), .Columns(2), 0)
  If IsNumeric(r) Then
         .Cells(r, 3).Resize(, 7).Value = sh.Range("f37:l37").Value
.Cells(r, 11) = sh.Range("N40").Value
        
         For Each cl In .Cells(r, 3).Resize(, 7)
           cl.Interior.ColorIndex = sh.Range("f37").Offset(, y).DisplayFormat.Interior.ColorIndex
            y = y + 1
         Next cl
    
        MsgBox "Data gekopieerd naar aantal karren !", vbInformation, "Copy"
 
  End If
 
Ik heb bovenstaande macro compleet, hij schrijft data naar het blad "Jaarproductie Karren 2023" je voelt het al nu begint een nieuw jaar het is makkelijk om dat stuk tekst te veranderen in "Jaarproductie Karren 2024" maar ik zou graag willen dat hij kijkt naar welk jaar het is bij de data wegschrijven en dan naar dat blad gaat.
 
Code: 
With Sheets("Jaarproductie Karren " & year(date))
let op: achter Karren staat een spatie en dan pas "
 
in 2023 slaat hij datums op in de onderste macro knop maar als ik een datum in 2024 in typ slaat hij niets op, op die datum in 2024 ?
En als ik nu de mappen in een dezelfde map los van dir programma plaats zodat ik het hoofdprogramma heb met de jaartal data apart erbij ?
 
Geen idee waar je het over hebt, ik zie geen onderste macroknop.
Misschien moet je het bestand even plaatsen, zou je ondertussen toch wel moeten weten.
En geef duidelijk aan waar het mis gaat.
 
Op het formulier "Teamleider-Productie Dashboard" staan 2 macro knoppen, de bovenste slaat de data van die dag op, met de onderste kun je een willekeurige datum inzetten en opslaan.
Als ik bij de onderste knop een datum van 2024 typ en druk opslaan (onderste knop) dan krijg ik een foutmelding hij slaat deze dan niet op in "Jaarproductie Karren 2024"
 
voor Button3
Code: 
Set sh = Sheets("Teamleider-Productie Dashboard")
With Sheets("Jaarproductie Karren " & Year(sh.Range("E45")))

Klik eens op foutopsporing als je een foutmelding krijgt en zorg ervoor dat je de codes begrijpt.
 
Code: 
Sub Button3_Click()
Set sh = Sheets("Teamleider-Productie Dashboard")
With Sheets("Jaarproductie Karren " & Year(sh.Range("E45")))
  r = Application.Match(sh.Range("e45"), .Columns(2), 0)
  If IsNumeric(r) Then
         .Cells(r, 3).Resize(, 7).Value = sh.Range("f37:l37").Value
.Cells(r, 11) = sh.Range("N40").Value
        
         For Each cl In .Cells(r, 3).Resize(, 7)
           cl.Interior.ColorIndex = sh.Range("f37").Offset(, y).DisplayFormat.Interior.ColorIndex
            y = y + 1
         Next cl
    
        MsgBox "Data gekopieerd naar aantal karren !", vbInformation, "Copy"
 
  End If

End With

With Sheets("Jaarproductie m3 " & Year(sh.Range("E45")))
  r = Application.Match(sh.Range("e45"), .Columns(2), 0)
  If IsNumeric(r) Then
         .Cells(r, 3).Resize(, 7).Value = sh.Range("f38:m38").Value
        
         For Each cl In .Cells(r, 3).Resize(, 7)
           cl.Interior.ColorIndex = sh.Range("f38").Offset(, y).DisplayFormat.Interior.ColorIndex
            y = y + 1
            Selection.ClearContents
            Range("E45").Activate
         Next cl
    
        MsgBox "Data gekopieerd naar aantal m3!", vbInformation, "Copy"
 
 
  End If

End With
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan