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

Gegevens uit werkbladen "totaliseren"

Status
Niet open voor verdere reacties.
Ik heb de code wat aangepast.
Lukt het zo?
Code: 
Dim lTR As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If lTR = 0 And WorksheetFunction.CountBlank(ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row)) = 0 Then
        lTR = Target.Row
        ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row).Copy Destination:=Worksheets("totaal").Range("A65536").End(xlUp).Offset(1, 0)
    End If
    lTR = 0
End Sub

Met vriendelijke groet,


Roncancio
 
Op zich lijkt het beter te werken, echter:

Wanneer iemand een "foutje"maakt en iets foutiefs ingeeft (bijvoorbeeld consultant 1 ipv 2) en dit later aanpast, dan krijg je een dubbele input.....

In deze versie is het overigens ook niet meer mogelijk data te "plakken", tenmiste; dan voert de code zich niet uit.....klopt dit?
 
Je zou een vraag kunnen stellen aan de gebruiker.

Code: 
Dim lTR As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If lTR = 0 And WorksheetFunction.CountBlank(ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row)) = 0 Then
        OK = MsgBox("Zijn alle gegevens correct ingevuld?", vbExclamation + vbYesNo)
        If OK = vbYes Then
            lTR = Target.Row
            ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row).Copy Destination:=Worksheets("totaal").Range("A65536").End(xlUp).Offset(1, 0)
        End If
    End If
    lTR = 0
End Sub

Zodra het gehele bereik is ingevuld verschijnt een melding of alle gegevens correct is ingevuld. Als de gebruiker op Ja klikt, gaat de macro verder.

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Je zou een vraag kunnen stellen aan de gebruiker.

Code: 
Dim lTR As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If lTR = 0 And WorksheetFunction.CountBlank(ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row)) = 0 Then
        OK = MsgBox("Zijn alle gegevens correct ingevuld?", vbExclamation + vbYesNo)
        If OK = vbYes Then
            lTR = Target.Row
            ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row).Copy Destination:=Worksheets("totaal").Range("A65536").End(xlUp).Offset(1, 0)
        End If
    End If
    lTR = 0
End Sub

Zodra het gehele bereik is ingevuld verschijnt een melding of alle gegevens correct is ingevuld. Als de gebruiker op Ja klikt, gaat de macro verder.

Met vriendelijke groet,


Roncancio
Klik om te vergroten...


Dit is übertof en lijkt helemaal te werken!!
Nog een vraagje.... op het totaal blad heb ik buiten kolom 1 t/m J (heb i in het bereik van je code aangepast) nog 2 kolommen met een formule erin. 1 om op basis van datum de weekdag te berekenen, de ander om het weeknummer te berekenen. Hoe kan ik de formule pas laten uitvoeren wanneer a t/m j is ingegeven op het totaal blad?
anders krijg ik namelijk bij alles dag 6 te staan en lijkt het alsof er heel veel op zaterdag verkocht wordt..... is mijn vraagstelling duidelijk?
 
Begin de code met:
Code: 
=ALS(aantalarg(A1:I1)=9; "jouw formule"

Aangezien het gehele bereik t/m I-kolom in totaal wordt geplaatst, volstaat
Code: 
=ALS(A1)<>""; "jouw formule"

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Begin de code met:
Code: 
=ALS(aantalarg(A1:I1)=9; "jouw formule"

Aangezien het gehele bereik t/m I-kolom in totaal wordt geplaatst, volstaat
Code: 
=ALS(A1)<>""; "jouw formule"

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Werkt super!
Wederom dank!

Mag ik nog een vraag stellen??
Uit veiligheidsoogpunt zou het een gerust gevoel geven als niemand iets kan aanpassen op het totaalblad. 2 optie's naar mijn mening:
1: het blad beveiligen: kan niet omdat de code de cellen dan niet kan vullen (vanwege de beveiliging)
2: het totaalblad verbergen, wat ze niet zien, kunnen ze niet aanpassen. Maar een slimmerik zou natuurlijk op zoek kunnen gaan naar verborgen bladen....

Hier nog een slimme oplossing voor?

Nogmaals dank voor alle reeds gegeven tips!
 
Punt 1 kan wel, hoor!
Via Protect en unprotect kan het werkblad beveiligd worden en kan de beveiliging er weer af worden gehaald. Bijv.:
Code: 
Dim lTR As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If lTR = 0 And WorksheetFunction.CountBlank(ActiveSheet.Range("A" & Target.Row & ":I" & Target.Row)) = 0 Then
        OK = MsgBox("Zijn alle gegevens correct ingevuld?", vbExclamation + vbYesNo)
        If OK = vbYes Then
            Worksheets("totaal").Unprotect Password:="cremer"
            lTR = Target.Row
            ActiveSheet.Range("A" & Target.Row & ":I" & Target.Row).Copy Destination:=Worksheets("totaal").Range("A65536").End(xlUp).Offset(1, 0)
            Worksheets("totaal").Protect Password:="cremer"
        
        End If
    End If
    lTR = 0
End Sub

Met vriendelijke groet,


Roncancio
 
:shocked::shocked:

En aan de reactiesnelheid te zien hoef je er niet eens lang over na te denken.....
 
Hallo allemaal,

Ik heb de vraag weer even opengezet omdat er iets dient aangepast te worden en ik kom er niet uit hoe dit zou moeten .....

Kan er een exclude worden ingebakken voor de kolommen ná kolom K ??

Waarom?
De macro heb ik zo aangepast dat kolom a t/m k ingevuld moeten worden om de macro uit te voeren. Indien dit het geval is komt de controlevraag, wordt deze met ja beantwoord dan wordt de kopie actie uitgevoerd. Na kolom K heb ik echter ook nog gegeven die ingevuld worden maar niet naar het totaalblad hoeven te worden gekopieerd. Maar vult iemand gegevens in kolom L in dan komt de controle vraag weer en vindt weer een kopie actie plaats, resultaat = dubbele gegevens in totaaloverzicht ....
 
Ja, bijvoorbeeld Target.Column<12 in de code gebruiken.

Maar wellicht is het handig om de code hier te plaatsen als het niet lukt.

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Ja, bijvoorbeeld Target.Column<12 in de code gebruiken.

Maar wellicht is het handig om de code hier te plaatsen als het niet lukt.

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

En daar is de altijd snelle Roncancio weer ... :thumb:

Dit is de code die ik gebruik (van jou gekregen...):

Dim lTR As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If lTR = 0 And WorksheetFunction.CountBlank(ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row)) = 0 Then
OK = MsgBox("Zijn alle gegevens correct ingevuld?", vbExclamation + vbYesNo)
If OK = vbYes Then
Worksheets("totaal").Unprotect Password:="wellness"
lTR = Target.Row
ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row).Copy Destination:=Worksheets("totaal").Range("A65536").End(xlUp).Offset(1, 0)
Worksheets("totaal").Protect Password:="wellness"

End If
End If
lTR = 0
End Sub

Maakt het wat uit waar ik de code plaats?
 
Laatst bewerkt:
Zo iets:
Code: 
Dim lTR As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
[B]If Target.Column<12 Then[/B]
If lTR = 0 And WorksheetFunction.CountBlank(ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row)) = 0 Then
OK = MsgBox("Zijn alle gegevens correct ingevuld?", vbExclamation + vbYesNo)
If OK = vbYes Then
Worksheets("totaal").Unprotect Password:="wellness"
lTR = Target.Row
ActiveSheet.Range("A" & Target.Row & ":K" & Target.Row).Copy Destination:=Worksheets("totaal").Range("A65536").End(xlUp).Offset(1, 0)
Worksheets("totaal").Protect Password:="wellness"
End If
End If
[B]End If[/B]

Met vriendelijke groet,


Roncancio
lTR = 0
End Sub
 
Hey,

bovenstaande heeft mij al erg veel geholpen voor mijn overzicht. Ik heb nu alleen een andere opstelling van bestanden.

Ik heb voor 20 werknemers een bestand om declaraties in te voeren.

In een apart bestand word via vertikaal zoeken gegevens voor 1 van de 3 teams gezet. Deze gegevens moet hij dan verzamelen in 1 bestand, alleen lukt dit mij niet als de gegevens via een formule worden weer gegeven, maar alleen bij handmatig invoeren.

kan ik hier iets aan doen met de vba code?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan