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

VBA om data te kopiëren naar overzicht blad

Status
Niet open voor verdere reacties.
R

ropo64

Gebruiker
Lid geworden
26 okt 2018
Berichten
51
hallo,
Ik wil graag van meerdere tabbladen specifieke cellen kopiëren naar een overzichttabblad met vba.

Elke week maak ik een nieuw tabblad aan waarvan de data naar het overzicht moet.

Van elk tabblad waarvan de naam met week begint moeten de volgende cellen gekopieerd worden:
L2 / J14 / K14 / K15 / K16 / U14 te beginnen met week 1 en uiteindelijk tot en met week 52
De data in het overzichtblad moet beginnen op A4 tot en met F4.
Als voorbeeld heb ik de data van week 1 in het overzicht geplaatst.
 

Bijlagen

  • Uren registratie 2019.xlsb
    59,3 KB · Weergaven: 29
Laatst bewerkt door een moderator:
Hoi,

Ik heb alle Private Subs uit je document in een apart tabblad gezet (Blad1), want had er last van en vervolgens de volgende macro geschreven:

Code: 
Dim Ctrl As Control
Dim iRow As Long, i As Long
Dim rng As Range, fnd As Range
Dim ws As Worksheet
Sub PasFormuleAan()   'Tot aan de formule is van HVS, geeft het regel nummer Lrij.
  With Blad1
    Dim cl As Range, Lrij As Long
    ActiveSheet.Unprotect
      Lrij = 1
        For Each cl In Columns(6).SpecialCells(-4123)
          If cl <> vbNullString Then Lrij = cl.Row    'Formule past automatisch het bereik aan.
        Next cl                   'Formule via opnemen en aangepast met Lrij door ExcelAmateur.
    [K37].Formula = "=SUMPRODUCT((WEEKDAY(R3C6:R" & Lrij & "C6,2)=6)*(R3C10:R" & Lrij & "C10))"
    [L37].Formula = "=SUMPRODUCT((WEEKDAY(R3C6:R" & Lrij & "C6,2)=7)*(R3C10:R" & Lrij & "C10))"
    ActiveSheet.Protect
  End With
End Sub
Sub Overbrengen()
Application.ScreenUpdating = False
Set ws = Worksheets("Overzicht")
    iRow = ws.Cells.Find(What:=T, SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    ws.Cells(iRow, 1).Resize(, 6).Value = Array(Sheets("Invoer").Range("L2").Value, Sheets("Invoer").Range("J14").Value _
        , Sheets("Invoer").Range("K14").Value, Sheets("Invoer").Range("K15").Value, Sheets("Invoer").Range("K16").Value _
        , Sheets("Invoer").Range("U14").Value)

ActiveSheet.Unprotect ""
Application.ScreenUpdating = False
tabnaam = "Week " & [b7] & " - " & [b6]
If IsError(Evaluate("'" & tabnaam & "'!A2")) Then
    Sheets("Invoer").Copy , Sheets(Sheets.Count)
    With ActiveSheet
        .Name = tabnaam
        On Error Resume Next
        For Each shp In .Shapes
            shp.Delete
        Next shp
        .UsedRange = .UsedRange.Value
        .[a1].Select
    End With
    With Sheets("Invoer")
        .[G7:L13].SpecialCells(2).ClearContents
        .[b7] = .[b7] + 1
        Application.GoTo .[L13]
        End With
    PasFormuleAan
 Else
    MsgBox "Het tabblad  " & tabnaam & "  bestaat al", , "Foutje dubbel"
End If

End Sub
 

Bijlagen

  • Kopie Uren registratie 2019.xlsb
    52,4 KB · Weergaven: 27
Laatst bewerkt:
Als je Excel als database gebruikt is het gebruikelijk alle gegevens in 1 werkblad (tabel) te zetten.
Gegevens per periode filter je dan eenvoudig met autofilter of advancedfilter.
Voor de invoer van gegevens gebruik je dan een userform.
 
JanBG,
sorry maar door jou aanpassingen werkt er niet veel meer:
tijden invoeren zonder : werkt niet meer
en met opslaan word er geen nieuw tabblad aangemaakt

ik heb het nu met wat gewone formules opgelost.
bedankt in ieder geval voor de moeite.

Groet Robert
 
Robert,

Als je de Private Subs weer terug zet naar de tabbladen waar ze stonden zou dat allemaal weer moeten werken.
Dat er geen nieuw tabblad wordt aangemaakt snap ik niet, want dat doet het in mijn testbestandje wel
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan