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

Macro maken voor gegevens van een andere tab blad te kopieren op een 2 de tab blad

Status
Niet open voor verdere reacties.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Variant
    Application.ScreenUpdating = False
    With Sheets("totaal")
        .Unprotect "Davy"
        .Range("A2:G" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
        For Each c In Sheets("uren").Range("B4:B150")
            If c <> "" Then
                .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2) = Cells(c.Row, 1).Resize(, 2).Value
                .Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = IIf(c.Offset(, 1) <> "", c.Offset(, 1).Value, c.Offset(, 4).Value)
            End If
        Next c
     .Protect "Davy"
     End With
     Application.ScreenUpdating = True
End Sub
Code: 
Private Sub Worksheet_Activate()
    ActiveSheet.Unprotect "Davy"
    Range("A2:C" & Cells(Rows.Count, 2).End(xlUp).Row).Sort [B1]
    If [A52] <> "" Then
        Range("A52:C" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
        Cells(2, 5).PasteSpecial xlPasteValues
        Range("A52:C" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    End If
    Application.CutCopyMode = False
    ActiveSheet.Protect "Davy"
End Sub
 
Warme bakkertje zei:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Variant
    Application.ScreenUpdating = False
    With Sheets("totaal")
        .Unprotect "Davy"
        .Range("A2:G" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
        For Each c In Sheets("uren").Range("B4:B150")
            If c <> "" Then
                .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2) = Cells(c.Row, 1).Resize(, 2).Value
                .Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = IIf(c.Offset(, 1) <> "", c.Offset(, 1).Value, c.Offset(, 4).Value)
            End If
        Next c
     .Protect "Davy"
     End With
     Application.ScreenUpdating = True
End Sub
Code: 
Private Sub Worksheet_Activate()
    ActiveSheet.Unprotect "Davy"
    Range("A2:C" & Cells(Rows.Count, 2).End(xlUp).Row).Sort [B1]
    If [A52] <> "" Then
        Range("A52:C" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
        Cells(2, 5).PasteSpecial xlPasteValues
        Range("A52:C" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    End If
    Application.CutCopyMode = False
    ActiveSheet.Protect "Davy"
End Sub
Klik om te vergroten...

Rudi,

Bedankt nu werkt alles zoals het zou moeten werken.:thumb:Top.

Ik durf het bijna niet meer te vragen maar heb nog iets vergeten.
Heb het proberen zelf op te lossen maar lukt niet.
In tabblad totaal zou er vanboven nog een regel bij moeten komen .
Waar ik dagstaat magazijn kan zetten en de datum laten halen uit tabblad uren cel b1.
Omdat dit blad wordt afgedrukt en daarom moet het een titel hebben en de datum.

Heb er een rij ingevoegd en in de code in tabblad totaal
Code: 
Range("A2:C" & Cells(Rows.Count, 2).End(xlUp).Row).Sort [B1]
de A2 aangepaast naar A3 maar dat werkt niet.
En heb ook in de code tabblad uren
Code: 
.Range("A2:G" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
A2 Veranderd in A3.
De eerste 3 kolmen a,b en c daar lukt het maar in de kolomen e,f en g daar werkt het niet als ik die aanpassing heb gedaan.
Wat moet ik dan juist aan de code aanpassen ?

Sorry dat ik hier nu pas bij uitkom maar zag het als ik de test pagina afdrukte.:o
 
Upload je bestandje eens zo als het qua layout moet worden Davy.
 
Bij dit bestand staat er nu alles in wat er in moet staan.
Op tabblad totaal daar heb ik alleen nog een rij toegevoegd vanboven met dagstaat magazijn en de datum die hij gaat halen in tabblad uren erin.

Alleen zit daar nu nog een foutje nu.

De namen zijn wel een beetje raar nu heb daar maar vlug iets ingeven zodat je de fout kan zien in tabblad totaal.

Bekijk bijlage vb bestand 4.xls
 
In tabblad totaal op rij 2 staan nu namen een daar zou moeten staan
A ploeg
B naam
C uren
D niets
E ploeg
F naam
G uren

En de laatste rij is leeg van onder .
 
Zo dan Davy.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Variant
    Application.ScreenUpdating = False
    With Sheets("totaal")
        .Unprotect "Davy"
        .Range("A3:G" & .Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
        For Each c In Sheets("uren").Range("B4:B150")
            If c <> "" Then
                .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2) = Cells(c.Row, 1).Resize(, 2).Value
                .Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = IIf(c.Offset(, 1) <> "", c.Offset(, 1).Value, c.Offset(, 4).Value)
            End If
        Next c
     .Protect "Davy"
     End With
     Application.ScreenUpdating = True
End Sub

Code: 
Private Sub Worksheet_Activate()
    ActiveSheet.Unprotect "Davy"
    Range("A3:C" & Cells(Rows.Count, 2).End(xlUp).Row).Sort [B2]
    If [A52] <> "" Then
      Range("A52:C" & Cells(Rows.Count, 2).End(xlUp).Row).Copy
        Cells(3, 5).PasteSpecial xlPasteValues
        Range("A52:C" & Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
    End If
    Application.CutCopyMode = False
    ActiveSheet.Protect "Davy"
End Sub
 
HSV zei:
Zo dan Davy.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Variant
    Application.ScreenUpdating = False
    With Sheets("totaal")
        .Unprotect "Davy"
        .Range("A3:G" & .Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
        For Each c In Sheets("uren").Range("B4:B150")
            If c <> "" Then
                .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2) = Cells(c.Row, 1).Resize(, 2).Value
                .Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = IIf(c.Offset(, 1) <> "", c.Offset(, 1).Value, c.Offset(, 4).Value)
            End If
        Next c
     .Protect "Davy"
     End With
     Application.ScreenUpdating = True
End Sub

Code: 
Private Sub Worksheet_Activate()
    ActiveSheet.Unprotect "Davy"
    Range("A3:C" & Cells(Rows.Count, 2).End(xlUp).Row).Sort [B2]
    If [A52] <> "" Then
      Range("A52:C" & Cells(Rows.Count, 2).End(xlUp).Row).Copy
        Cells(3, 5).PasteSpecial xlPasteValues
        Range("A52:C" & Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
    End If
    Application.CutCopyMode = False
    ActiveSheet.Protect "Davy"
End Sub
Klik om te vergroten...

Dat probleem heb je ook weer mooi opgelost.:thumb:

Nu heb ik nog een andere probleem waar jullie mischien ook wel raad mee weten.

Heb dit allemaal thuis gemaakt in ziekte verlof met excel 2007.
Het is echter voor het werk en daar draait enkel excel 2003.
Ik weet dat het voor problemen kan zorgen maar had er niet bij stil gestaan

In het tablad uren daar zit in kolom g van 4 tem 44 een code die het volgende zou moeten doen.
Op maandag geen 30 min pauzen aftrekken.
Op Dinsdag geen 30 min pauzen aftrekken.
Op Woensdag geen 30 min pauzen aftrekken.
Op Donderdag geen 30 min pauzen aftrekken.
Op vrijdag wel 30 min pauzen aftrekken.

En een dag die voor een belgische feestdag valt moet er ook 30 min pauzen worden afgetrokken.
In het tabblad feest staan de feestdagen in van belgie.

In excel 2003 werkt er van dat alles niks meer.
En in excel 2007 werkt het nu ook niet meer hoe het zou moeten.
De vrijdagen doet hij dan wel nog juist maar de feestdagen doet hij enkel rij 4 of rij 4 en 5 naar gelang welke feestdag je kiest en de andere rijen veranderd er dan niks.:(

Weten jullie hier mischien ook raad mee.:o
 
Het bereik in je formule dat naar de feestdagen kijkt zit overal fout. Pas dit aan in G4 en zet het vast met $, trek door naar beneden
 
Laatst bewerkt:
Warme bakkertje zei:
Het bereik in je formule dat naar de feestdagen kijkt zit overal fout. Pas dit aan in G4 en zet het vast met $, trek door naar beneden
Klik om te vergroten...

Sorry maar begrijp niet goed wat je bedoeld.

Code: 
=ALS(EN(AANTALARG(D4:E4)=2;F4>$H$2);ALS(EN(OF(WEEKDAG($B$1;2)=5;NIET(ISFOUT(VERT.ZOEKEN($B$1+1;feest!A10:A23;1;0))));$A4="Pt avond");AFRONDEN.N.VEELVOUD(F4-$H$2;1/24/4);F4);"")

Wat moet er juist worden aangepast aan de code ?
Sorry dt ik niet weet wat je juist bedoeld maar met codes ben ik helemaal niet goed.:o
 
Code: 
=ALS(EN(AANTALARG(D4:E4)=2;F4>$H$2);ALS(EN(OF(WEEKDAG($B$1;2)=5;NIET(ISFOUT(VERT.ZOEKEN($B$1+1;[COLOR="red"]feest!A10:A23[/COLOR];1;0))));$A4="Pt avond");AFRONDEN.N.VEELVOUD(F4-$H$2;1/24/4);F4);"")
Pas het rode gedeelte aan, aan de werkelijke situatue bv feest!$A$2:$A$10 en trek de formule met de vulgreep (vierkantje rechts onderaan de cel)door naar beneden
 
Warme bakkertje zei:
Code: 
=ALS(EN(AANTALARG(D4:E4)=2;F4>$H$2);ALS(EN(OF(WEEKDAG($B$1;2)=5;NIET(ISFOUT(VERT.ZOEKEN($B$1+1;[COLOR="red"]feest!A10:A23[/COLOR];1;0))));$A4="Pt avond");AFRONDEN.N.VEELVOUD(F4-$H$2;1/24/4);F4);"")
Pas het rode gedeelte aan, aan de werkelijke situatue bv feest!$A$2:$A$10 en trek de formule met de vulgreep (vierkantje rechts onderaan de cel)door naar beneden
Klik om te vergroten...

Denk dat ik nu mee ben.
Het rode gedeelte moet in elke cel het zelfde zijn ? Zoals hieronder.
Of ben ik nog fout?

Code cel G4
Code: 
=ALS(EN(AANTALARG(D4:E4)=2;F4>$H$2);ALS(EN(OF(WEEKDAG($B$1;2)=5;NIET(ISFOUT(VERT.ZOEKEN($B$1+1;feest!A2:A11;1;0))));$A4="Pt avond");AFRONDEN.N.VEELVOUD(F4-$H$2;1/24/4);F4);"")


Code cel G 5
Code: 
=ALS(EN(AANTALARG(D5:E5)=2;F5>$H$2);ALS(EN(OF(WEEKDAG($B$1;2)=5;NIET(ISFOUT(VERT.ZOEKEN($B$1+1;feest!A2:A11;1;0))));$A5="Pt avond");AFRONDEN.N.VEELVOUD(F5-$H$2;1/24/4);F5);"")
 
Als ik de code in cel g 4 met de vulgreep naar benede trok naar de andere cellen dan veranderd het rode gedeelte elke keer ook, en dan werkte het niet.
Daarom bleef het niet lukken denk.:D
 
Code: 
feest![COLOR="red"]$[/COLOR]A[COLOR="red"]$[/COLOR]2:[COLOR="red"]$[/COLOR]A[COLOR="red"]$[/COLOR]11
Davy, het is zeer belangrijk dat je de gegeven antwoorden grondig leest. Door het bereik vast te zetten met $ wordt het bereik niet gewijzigd bij het naar beneden doortrekken van je formule
 
Laatst bewerkt:
Kijk naar de dollartekens in het voorbeeld van Rudi.
feest!$A$2:$A$10

Dit is gemakkelijk te veranderen met sneltoets F4.
 
Warme bakkertje zei:
Code: 
feest![COLOR="red"]$[/COLOR]A[COLOR="red"]$[/COLOR]2:[COLOR="red"]$[/COLOR]A[COLOR="red"]$[/COLOR]11
Davy, het is zeer belangrijk dat je de gegeven antwoorden grondig leest. Door het bereik vast te zetten met $ wordt het bereik niet gewijzigd bij het naar beneden doortrekken van je formule
Klik om te vergroten...

Ja had u vorige bericht niet goed genoeg gelezen blijkbaar. :confused: sorry :o

Het werkt nu perfect op mijn pc onder excel 2007.
Als ik het zelfde bestand nu gewoon naar het netwerk verzet van het werk en daar het open doe met excel 2003 dan krijg ik een fout.
Als ik de datum dan aanpas naar een vrijdag of zo een feestdag dan komt er in de kolom g waar die code van feest inzitten het volgende te staan "#NAAM?"

Verander ik de datum terug naar een ma,di,wo of donderdag dan staan er terug de juiste uren.

Waar kan dit aan liggen ?
 
Het ligt in ieder geval niet aan het netwerk van het werk.
Heb op mijn pc excel 2003 er ook even terug opgezet en daar is het zelfde probleem .:confused:
 
Mi herkent hij in de formule een bepaalde functie niet. Kijk eens na of Analysis ToolPack aangevinkt is bij invoegtoepassingen.
 
Warme bakkertje zei:
Mi herkent hij in de formule een bepaalde functie niet. Kijk eens na of Analysis ToolPack aangevinkt is bij invoegtoepassingen.
Klik om te vergroten...

Rudi,

Op de excel versie die ik op mijn pc heb gezet was dit inderdaad het het probleem.
Heb het aangevinkt en het werkt wel.:thumb::D

Op het netwerk van het werk heb ik het ook moeten aanvinken maar daar werkt het nog steeds niet.:confused:
 
Met netwerken heb ik absoluut geen ervaring, dus zal ik hier ff moeten passen :(
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan