Gegevens blad1 permanent bewaren op blad 2

[rvdw1968]

Beste allemaal,

Voor mijn werk ben ik bezig met het maken van een spreadsheed waarin wordt bijgehouden welke projecten op dit moment uitgevoerd worden. Op blad1 worden alle gegevens ingetypt waardoor er een realtime overzicht ontstaat. Deze gegevens wil ik kopiëren naar blad2. Dat is op zich natuurlijk niet zo moeilijk (blad1!A3).

Wat ik echter wil is dat blad2 een lijst wordt waarin ALLE gegevens die ooit ingevoerd zijn op blad1, vermeld staan. deze gegevens moeten bewaard blijven, ook als de gegevens van blad1 verwijderd worden. Met andere woorden: Blad1 is een real time overzicht en blad2 is een totaal overzicht (heden en verleden)

Probleem waar ik ook tegenaan loop is dat de waarde van bijvoorbeeld Blad1A3 natuurlijk regelmatig wisselt door invoer-delete-opnieuw invoer. De werkwijze die ik hierboven heb weergegeven (blad1!A3) werkt dus niet want die pakt alleen de huidige ingevoerde waarde terwijl dus alle ooit ingevoerde waardes in de lijst moeten blijven staan. Ik hoop dat mijn omschrijving van het probleem een beetje duidelijk is zo niet, dan verneem ik het graag.

Alvast veel dank voor jullie hulp
Ruud

 

[edmoor]

Plaats een voorbeeld document.
Dan wordt je beter en sneller geholpen.

Zie ook:
https://www.helpmij.nl/forum/announcement.php?f=5

 

[rvdw1968]

voorbeeldbestand

Edmoor,

dank voor de tip, inderdaad wel zo handig.

Hierbij het voorbeeldbestand

 

[edmoor]

Dat kan dan met iets als dit:

Sub Historie()
    stRow = Sheets("Blad2").Range("A1").CurrentRegion.Rows.Count
    With Sheets("Blad1")
        For i = 9 To 36
            If .Cells(i, 1) <> "" Then
                stRow = stRow + 1
                Sheets("Blad2").Cells(stRow, 1) = .Cells(i, 1).Value
                Sheets("Blad2").Cells(stRow, 2) = .Cells(i, 3).Value
                Sheets("Blad2").Cells(stRow, 3) = .Cells(i, 5).Value
                Sheets("Blad2").Cells(stRow, 4) = .Cells(i, 7).Value
            End If
        Next i
    End With
End Sub

 

[rvdw1968]

Beste Edmoor,

G E W E L D I G bedankt, precies wat ik bedoelde.

 

[edmoor]

Graag gedaan
Kan netter geschreven worden maar zo is het duidelijk wat waar vandaan waar naar toe gaat.

 

[rvdw1968]

toch nog een vraag

Edmoor,

is het wellicht mogelijk dat ik je prive een voorbeeld stuur van het document dat ik daadwerkelijk heb gemaakt waarin ik de macro wil toepassen?

Ik stuit toch op wat problemen en ik wil de inhoud van het bestand niet algemeen bekendstellen

Groeten,

Ruud

 

[edmoor]

Dat is niet gebruikelijk of de bedoeling op een forum, maar vooruit, omdat je nieuw bent hier.
Beschouw het dan maar als een Helpmij welkomst cadeautje

 

[rvdw1968]

mijn excuses

Sorry voor mijn fout....learning all the time

Dan zal ik het proberen te verwoorden.

Ik heb in het reeds geplaatste document als kop een aantal rijen gebruikt voor titels en dergelijke. Deze gegevens moeten niet gekopieerd worden naar Blad2. (ik wil dus niet de gehele Row1 gebruiken maar slechts vanaf A9)

Praktisch gezien: de gegevens vanaf cel A9 t/m A36, C9 T/M C 36 (kolom B dus niet), D9 T/M D39 enz...... wil ik dus permanent kopieren naar blad2.

(rij 1 t/m 8 op blad1 zijn vergrendeld)

 

[edmoor]

Waar gaat het nu mis dan? Want dat is precies wat mijn voorbeeld doet in je voorbeeld documentje.

 

[rvdw1968]

Wat er mis gaat is dat de waarden van de titels (geblokkeerde cellen) van blad 1 ook gekopieerd worden bijvoorbeeld:

Blad1 cel A5 wordt gekopieerd naar blad2 cel A3
Blad1 cel A7 wordt gekopieerd naar blad2 cel A4
Blad1 cel A38 wordt gekopieerd naar blad2 cel A6
enz

Bovenstaande is niet de bedoeling, wat wél de bedoeling is is dat de titels (geblokkeerde cellen) niet gekopieerd worden en dat:

Blad1 cel A9 (en verder tot aan cel A36) gekopieerd wordt naar Blad2 cel A4 (en verder tot aan ....)
Blad1 cel C9 (en verder...) gekopieerd wordt naar Blad2 cel B4
Blad1 cel E9 (en verder ...)gekopieerd wordt naar Blad2 cel C4
enz.

(zoals je ziet, in blad1 ontbreken enkele kolommen, deze zijn verborgen)

Alvast dank voor de grote hoeveelheid tijd die je al gespendeerd hebt om mij te helpen.

 

[edmoor]

Die verborgen kolommen worden door mijn voorbeeld inderdaad overgeslagen.
Is dat niet de bedoeling dan?
Stuur me dan toch, zoals in #8 al aangeboden, dat document even.
Je kan me mailen door op mijn naam te klikken.

 

[rvdw1968]

De oplossing

Beste allemaal,

edmoor heeft geweldig goed geholpen en onderstaand staat de macro die hij voor mij geschreven heeft.
Deze macro zorgt ervoor dat bepaalde geselecteerde gegevens gekopieerd worden van blad1 naar blad2

De macro houdt er ook rekening mee dat gekopieerde gegevens niet dubbel op de lijst van blad2 verschijnen door gebruik van het unieke nummer XXX

[SIZE=1]Sub kopieerblad1naarblad2()
    Dim rtu As Long
    Dim XXX As Range
    Dim shOLZ As Worksheet
    Dim shOLB As Worksheet
   
    Set shOLZ = Sheets("blad1")
    Set shOLB = Sheets("blad2")
   
    With shOLB
        rtu = 4
        While .Cells(rtu, 1) <> ""
            rtu = rtu + 1
        Wend
    End With

    For i = 9 To 36
        If shOLZ.Cells(i, 1) <> "" Then
            Set XXX = shOLB.Columns("E").Find(shOLZ.Cells(i, "K").Value, LookIn:=xlValues)
            If XXX Is Nothing Then
                shOLB.Cells(rtu, "A") = shOLZ.Cells(i, "A").Value
                shOLB.Cells(rtu, "B") = shOLZ.Cells(i, "C").Value
                shOLB.Cells(rtu, "C") = shOLZ.Cells(i, "E").Value
                shOLB.Cells(rtu, "D") = shOLZ.Cells(i, "G").Value
                shOLB.Cells(rtu, "E") = shOLZ.Cells(i, "K").Value
                shOLB.Cells(rtu, "F") = shOLZ.Cells(i, "AM").Value
                shOLB.Cells(rtu, "G") = shOLZ.Cells(i, "AN").Value
                shOLB.Cells(rtu, "I") = shOLZ.Cells(i, "AO").Value
                rtu = rtu + 1
            End If
        End If
    Next i
End Sub[/SIZE]

edmoor, hartelijk dank voor de oplossing

 

[edmoor]

Graag gedaan