Terugschrijven van eerder verkregen gegevens na correctie

Status
Niet open voor verdere reacties.

Sansje

Gebruiker
Lid geworden
21 dec 2014
Berichten
50
He hallo allemaal daar ben ik weer even. Ik ben bezig om voor mijn vriend alle basisgegevens van oude facturen over te zetten in een nieuw bestand. De oude facturen heb ik al ingevoegd en de gegevens heb ik ook al via onderstaande code naar 1 tabblad weggeschreven. Omdat hier een aantal slordigheden in stonden, wil ik nu ik de gegevens op dat ene tabblad heb aangepast vernieuwd en zonder slordigheden weer terugschrijven naar de facturen toe. De slordigheden zijn bijvoorbeeld een teveel aan spaties, wel of geen hoofdletters en of streepjes etc.

Het tabblad waar ik alle gegevens op heb verzameld, wordt weer gebruikt voor gegevens voor nieuwe facturen.

Ik kan mij geen code bedenken die de gegevens weer in juiste terugschrijft op de oude facturen op de juiste plek. Kan iemand mij deze code geven?

De tijdelijke code die ik nu gebruikt heb is als volgt:

Code:
Sub TakeInfo() 'Van alle tabbladen vanaf tabblad 11, bepaalde gegevens naar 1 database wegschrijven (Tabblad Debiteuren)
    Dim i As Integer
    Dim x As String
    Dim y As String

    For i = 11 To Sheets.Count - 1
        'Postcode en Plaats in cel F11 splitsen en spaties voor en achter de 2 waarden verwijderen
        x = Trim(Left(Sheets(i).Range("F11"), 4))
        y = Trim(Mid(Sheets(i).Range("F11"), 6))
        
        With Sheets("Debiteuren")
            .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = Array(Sheets(i).Range("F7"), Sheets(i).Range("F9"), x, y, Sheets(i).Range("G14"))
        End With
    Next
    
End Sub

Weet iemand het antwoord?

Liefs Sandra
 
Laatst bewerkt:
O ja wellicht handig voor jullie.

Het is gewoon een simpele lijst die begint op cel A2 en zo door naar beneden. Rij 1 is dus bezet.
Gebruikt zijn de kolommen A, B, C, D en E waarvan de gegevens van C en D, met twee spaties ertussen, weer bij elkaar in 1 cel moeten staan. Dit betreft namelijk de postcode en plaats.

Cel F7 is de naam van de klant (Kolom A), Cel F9 is het adres van de klant (Kolom B), Cel F11 is de Postcode en Plaats van de klant (Kolom C en Kolom D) en Cel G14 is het btw nummer van de klant (Kolom E). De genoemde kolommen tussen haakjes, komen van het tabblad af waar alle gegevens op zijn verzameld.

Groetjes Sandra

Bekijk bijlage Testbestand.xlsm
 
Laatst bewerkt:
Sansje,

Volgens mij moet de volgende code wel werken.

Code:
Sub TakeBack()
    Dim i As Integer
    
    For i = 1 To Sheets.Count - 1
        With Sheets("Debiteuren")
            Sheets(i).Range("F7") = .Range("A2").Offset(i - 1, 0)
            Sheets(i).Range("F9") = .Range("A2").Offset(i - 1, 1)
            Sheets(i).Range("F11") = .Range("A2").Offset(i - 1, 2) & _
                "  " & .Range("A2").Offset(i, 3)
            Sheets(i).Range("G14") = .Range("A2").Offset(i - 1, 4)
        End With
    Next
End Sub

Veel Succes.
 
Beste Elsendoorn. Ik heb jou code uitgeprobeerd. In het testbestand van mij werkt deze goed. Ik moet alleen bekennen dat ik hier twee kleine foutjes in heb gemaakt. Mijn werkelijke bestand telt namelijk nog 10 tabbladen ervoor en het tabblad debiteuren is eigenlijk tabblad 4 in plaats van in het testbestand tabblad 4.

Dus eigenlijk moet deze vanaf tabblad 11 beginnen. Nu heb ik zelf de for i=1 to sheets.count -1 veranderd in for i=11 to sheetscount en ingevoegd. Als ik nu jouw code met mijn aanpassing uit laat voeren dan wordt blad 11 gevuld met de gegevens van rij 1 in mijn database. Volgens mij was de for i=11 ook te zien in mijn reactie 1.

Wil jij hier nog even naar kijken?? Dank je wel. Groetjes Sansje
 
Laatst bewerkt:
Sansje,

Ik heb de macro gemaakt voor je voorbeeld.
Ik gebruik de i voor zowel het sheetnummer als de regelnummer. Je zou deze uit elkaar kunnen halen
of deze herberekenen. Probeer de volgende code eens.

Code:
Sub TakeBack()
    Dim i As Integer
    
    For i = 11 To Sheets.Count - 1
        With Sheets("Debiteuren")
            Sheets(i).Range("F7") = .Range("A2").Offset(i - 11, 0)
            Sheets(i).Range("F9") = .Range("A2").Offset(i - 11, 1)
            Sheets(i).Range("F11") = .Range("A2").Offset(i - 11, 2) & _
                "  " & .Range("A2").Offset(i-11, 3)
            Sheets(i).Range("G14") = .Range("A2").Offset(i - 11, 4)
        End With
    Next
End Sub

Deze code zorgt er voor dat de regel 1 wordt geplaatst op sheet 11 regel 2 op sheet 12 etc.

Veel Succes.
 
:eek: Oeps. Sorry dat van die i was mij nog niet opgevallen. Inderdaad ik zie het. Dom van mij.
Dan laat ik de -1 bij de for wel weg hoor. Hihi.
Ik ga het uitproberen. Je hoort van mij. Groetjes
 
Elsendoorn, fantastisch. Het werkt. Scheelt weer een hoop werk. Middels mijn code kan ik alles in 1 keer gecorrigeerd op een tabblad krijgen waar de gegevens ook moeten staan en middels jou code kan ik de verbeterde gegevens meteen teruggeven aan de tabbladen. Er zijn wel na correctie en transporteren naar het tabblad een klaar kleine puntjes die ik niet met VBA voor elkaar kan krijgen, maar dat is zo weinig dat het in feite niet eens waard is om daar een code voor aan te maken. Immers ik ben sneller klaar met die paar kleinigheden handmatig corrigeren dan dat ik klaar ben om een hele code te schrijven.

Ik geef voor de volledigheid beide code onder elkaar. Mijn eigen code heb ik ook aangepast omdat er meer hiaten in alle gegevens zaten dan ik dacht. Veel overbodige spaties, verschillend gebruik van hoofdletters en kleine letters etc.

Code:
Sub TakeInfo() 'Vanaf tabblad 11, bepaalde gegevens in cellen naar 1 database wegschrijven (Tabblad Debiteuren)
    Dim i As Integer
    Dim v As String
    Dim w As String
    Dim x As String
    Dim y As String
    Dim z As String

    For i = 11 To Sheets.Count
        'Application.Trim verwijderd alle voorloop -en achter spaties en overbodige spaties in de string
        'Application.Proper geeft iedere eerste letter van ieder woord in een cel een hoofdletter en maakt de rest kleine letters
        
        v = Application.Proper(Application.Trim(Sheets(i).Range("F7"))) 'Naam
        w = Application.Proper(Application.Trim(Sheets(i).Range("F9"))) 'Straat + Huisnummer
        x = Application.Trim(Left(Sheets(i).Range("F11"), 4)) 'postcode
        y = UCase(Application.Trim(Mid(Sheets(i).Range("F11"), 6))) 'plaats in hoofdletters
        z = UCase(Trim(Sheets(i).Range("G14"))) 'btw nummer omzetten naar hoofdletter
        
        With Sheets("Debiteuren")
            .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = Array(v, w, x, y, z)
        End With
    Next
    
End Sub

Sub TakeBack() 'Gegevens terugplaatsen in juiste cellen op tabbladen vanaf tabblad 11
    Dim i As Integer
    
    For i = 11 To Sheets.Count
        With Sheets("Debiteuren")
            Sheets(i).Range("F7") = .Range("A2").Offset(i - 11, 0)
            Sheets(i).Range("F9") = .Range("A2").Offset(i - 11, 1)
            Sheets(i).Range("F11") = .Range("A2").Offset(i - 11, 2) & _
                "  " & .Range("A2").Offset(i - 11, 3)
            Sheets(i).Range("G14") = .Range("A2").Offset(i - 11, 4)
        End With
    Next
End Sub

Misschien dat sommigen hier op dit forum iets aan deze code hebben als zij met hetzelfde zitten. :D
 
Even wel een aanvullende vraag en alvast sorry aan het beheer.

Via: Sheets.Name kun je de gegeven naam van het tabblad ophalen.
Via: Sheets.Index kun je het volgnummer van de tabbladen in het programma Excel ophalen.

Wat mij opvalt is dat de volgnummers opgehaald via Sheets.Index niet overeenkomen met de bladnummering in het venster: projectverkenner van VBA. Is er een mogelijkheid om deze bladnummering ook op te vragen. Immers Excel en VBA zijn losse programma's van elkaar. Het kan soms wel eens schelen als je ook de inhoudsopgave van het venster projectverkenner kunt weergeven. Soms vergemakkelijkt dit het zoeken naar het juiste tabblad en zo sneller de bijbehorende programmacode. Voor een paar tabbladen maakt dit niet zo veel uit, maar als je net als ik er ruim 300 in hebt staan, zoek je soms naar een speld in een hooiberg.

Groetjes Sansje
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan