• 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 meerdere tabbladen kopieeren naar 1 werkblad

Status
Niet open voor verdere reacties.
J

janmulder85

Gebruiker
Lid geworden
11 aug 2007
Berichten
63
Beste forumleden,

Momenteel ben ik bezig met het aanpassen/uitbreiden een bestaande excel werkmap met macro's.

Graag zou ik een code willen die uit elk van de tabbladen 'Ma', 'Di', 'Wo', 'Do', en 'Vr' de cijfers (indien ingevuld) in de cellen C8 t/m C22 filtert en vervolgens in het tabblad 'Totalen' verzameld/kopieert in de cellen C8 t/m C22.

Achter de cijfers in de tabbladen 'Ma', 'Di', 'Wo', 'Do', en 'Vr' staat in de D kolom een hoeveelheid ingevuld. Deze wil ik ook graag verzamelen in het tabblad 'Totalen' achter het betreffende cijfer.

Als er bijvoorbeeld in zowel 'Ma' en 'Di' in de C kolom een 4 staat ingevuld staat dan hoeft in tabblad 'Totalen' geen tweemaal een 4 weergegeven worden. De hoeveelheden van 'Ma' en 'Di' achter deze 4 moeten echter wel opgeteld worden en als 1 getal weergegeven worden in 'Totalen'.

De code wil ik onder een knop plakken die vervolgens een weekoverzicht maakt.

Helaas heb ik nog geen bruikbaar voorbeeld, dus ik hoop dat ik het duidelijk genoeg uitgelegd heb...

Kan iemand mij verder helpen?

Alvast hartelijk dank! :thumb:
 
janmulder85 zei:
Helaas heb ik nog geen bruikbaar voorbeeld, dus ik hoop dat ik het duidelijk genoeg uitgelegd heb...
Klik om te vergroten...

Voor mij in ieder geval is het niet duidelijk, ik hoop voor jou dat het voor anderen wel duidelijker is.
 
Als ik dit zo lees dan denk ik dat je in VBA met find aan het werk moet.
Ik ben alleen geen ster met VBA.
Ik kan je wel een voorbeeld geven van een probleem dat ik had met het copieren van gegevens naar een ander tabblad. Maar dit zal niet de oplossing zijnvoor jou probleem, aangezien je toch wat andere wensen bent dan ik destijds.
 
Beste Wigi,

Ik heb een voorbeeldje bijgesloten, de hoeveelheden waar ik over schreef in m'n eerdere post staan nu in de I kolom ipv. D.

Hopelijk is het zo duidelijker...

@VAMEES:

Ik ben wel geinteresseerd in je voorbeeldbestandje, wellicht kan ik er iets mee!
 

Bijlagen

Laatst bewerkt:
HTML: 
Sub VindRoute10()
  
    Dim c As Range
    Dim firstAddress As String
    
    With Sheets(1).Range("a3:a500")
        Set c = .Find(10, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.EntireRow.Copy Sheets("locatie 10").Range("A" & Rows.Count).End(xlUp).Offset(1)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With

End Sub

Deze VBA code heb ik destijds van WIGI gekregen.
Hij copieerd alle regels die is cel A de waarde 10 hebben en plaatst deze vervolgens op een andere scheet.
 
Je wilt die gegevens dus in rij 8 tot rij 22 verzamelen op de sheet totalen. Wat doe je als er meer gegevens in de tabs ma, di, wo, do, vr staan dan dat er beschikbare rijen zijn in de sheet totalen (dus meer dan 15 gegevens)?
 
@Finch

Dat is inderdaad een goede opmerking. Omdat ik nog aan het ontwikkelen ben moet ik nog bepalen of het inderdaad genoeg regels zijn, al heb ik bewust voor 15 gekozen.

Maar stel dat het niet genoeg is dan kan ik in de tabbladen extra regels invoegen en het bereik in de code ook daarnaar aanpassen toch?
 
Dat kan uiteraard, maar ik bedoel eigenlijk nog iets anders.

In de sheets ma, di, wo, do, vr heb je telkens 15 regels om gegevens in te voeren. Dus mogelijk 5x15=75 verschillende gegevens. En je sheet totalen heeft ook maar 15 rijen om gegevens te bevatten. Dat kan al snel voor problemen zorgen. Wat wil je dat er gaat gebeuren als je in de 5 sheets pakweg 30 gegevens hebt. In de sheet totalen deze 30 gegevens weergeven (en daarvoor moet dus het bereik worden uitgebreid in deze totalen sheet) of wil je maar 15 gegevens weergeven (bereik van totalen behouden).
 
Nu begrijp ik je, ik had daar niet aan gedacht. Dan moet inderdaad zeker het tabblad 'Totalen' uitgebreidt worden als er meer gegevens beschikbaar zijn dan 15. is hier ook een code voor die standaard 15 regels zichtbaar laat en uitbreidt als er meer gegevens in Ma t/m Vr staan?
 
Ik heb snel wat code geschreven die je zou moeten helpen. Aangezien het "maar" 15 cellen per tabblad is dat moet worden doorlopen heb ik een for...next lus gekozen. Deze is misschien minder performant maar voor zo'n klein aantal cellen gaat dat geen probleem opleveren. Bij performanceproblemen, is een filter beter.
Ik veronderstel wel dat op je totalen sheet, je de range voor data weg te schrijven vergroot van C8:C22 tot C8:C82. De rij van de totalen (totaal opbrengsten) komt dan op rij 83 (cfr. eerdere opmerkingen over dit probleem)

Code: 
[FONT="Courier New"]Option Base 1
'---------------------------------------------------------------------------------------
' Procedure : Totaliseren
' Author    : Finch
' Date      : 27/12/2007
' Purpose   : http://www.helpmij.nl/forum/showthread.php?p=2161833&posted=1#post2161833
'---------------------------------------------------------------------------------------
'
Sub Totaliseren()
Dim ListSheets() As Variant
Dim shtTotaal As String
Dim rSourceRange As Range
Dim sSourceRange As String
Dim rTargetRange As Range
Dim rSearchRange As Range
Dim rCell As Range
Dim shtItem As Long
Dim lOffsetColumn As Long

ListSheets = Array("Ma", "Di", "Wo", "Do", "Vr")
shtTotaal = "Totalen"
Set rTargetRange = Sheets(shtTotaal).Range("C8:C82")
lOffsetColumn = 6
sSourceRange = "C8:C22"

'Totalen eerst leegmaken
rTargetRange.EntireRow.Hidden = False
rTargetRange.ClearContents
rTargetRange.Offset(, lOffsetColumn).ClearContents

For shtItem = 1 To UBound(ListSheets)
    Set rSourceRange = Sheets(ListSheets(shtItem)).Range(sSourceRange)
    For Each rCell In rSourceRange
        If Not rCell = vbNullString Then
            With Sheets(shtTotaal).Range(SearchItem(rCell, rTargetRange))
                .Value = rCell
                .Offset(, lOffsetColumn) = .Offset(, lOffsetColumn) + rCell.Offset(, lOffsetColumn)
            End With
        End If
    Next rCell
    Set rSourceRange = Nothing
Next shtItem
rTargetRange.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End Sub

Function SearchItem(ByVal SearchValue As Variant, ByVal SearchRange As Range) As String
Dim rngResult As Range
Set rngResult = SearchRange.Find(SearchValue)
If Not rngResult Is Nothing Then
    SearchItem = rngResult.Address
Else
    SearchItem = SearchRange.SpecialCells(xlCellTypeBlanks)(1).Address
End If
End Function[/FONT]
 
Hartelijk dank Finch! :thumb:

Ik heb de code geprobeerd en hij werkt uitstekend, ik ben er erg blij mee!:D

Wat mij betreft opgelost.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan