Kopiëren en plakken in ander excel blad

[CygneVoler]

Hoi excellers,

Graag vraag ik jullie hulp voor het volgende.

Wat heb ik:
(zie bijgevoegd bestand) Een bestellijst. Hierop worden de wekelijkse bestellingen ingevoerd. Nadat deze besteld zijn wil ik de bestelling kopiëren naar een een BestelOverzicht.
Hiervoor kopieer ik een aantal kolommen welke worden geplakt in het overzicht.
Voor de duidelijkheid: de overige kolommen hoeven niet mee gekopieerd te worden omdat de gegevens via verticaal-zoek-functie uit een database wordt gehaald die ik niet aan dit bestand gekoppeld heb. Hiervoor gebruik ik de volgende code:

Private Sub CommandButton1_Click()
Sheets("Bestelling").Range("A3:A28,F3:F28,J3:J28,K3:K28").Copy
Sheets("BestelOverzicht").Select
Sheets("BestelOverzicht").Range("B3").Select
ActiveSheet.Paste
End Sub

Wat ik graag wil is dat de tekst uit kolom A3 "Bestelling" gekopieerd wordt in kolom B3 "BestelOverzicht". F3, naar F3, J3 naar G3 en K3 naar H3. En dat wil me dus niet lukken.

Nu zou ik ook graag willen dat het BestelOverzicht een overzicht blijf wat "aangroeit". Dus ik geef nu aan dat het gekopieerd moet worden in kolom B3 maar wanneer deze gevuld is moet het dus onder de laatste regel geplakt worden. Snappie!?

Dus de bestellijst wordt wekelijks gevuld met nieuwe input,
en het overzicht wordt steeds aangevuld met nieuwe input middels plakken en knippen (groeit aan)

Hoop dat het duidelijk is.

Wie kan me helpen?

Alvast erg bedankt voor jullie advies en hulp.

 

[edmoor]

Bekijk dit voorbeeld eens:
Bekijk bijlage Kopie van Forem.xlsm

Let op. Het gaat heel snel en als je 2x klikt heb je uiteraard dubbele gegevens in het besteloverzicht staan.
Kan je uiteraard naar wens aanpassen.

 

[CygneVoler]

Werk idd goed Edmoor. Ik zie ook dat je de bestelcode, leverancier en omschrijving 1 hebt mee gekopieerd. Zoals ik al in mijn intro schrijf komt deze info uit een database welke me verticaal zoeken wordt opgehaald. Wordt in dit geval dan alleen tekst gekopieerd of de formule? Alleen tekst zou prima zij b.t.w.!

 

[edmoor]

Alleen de tekst wordt gekopiëerd.
Verder heb ik gewoon overeenkomende cellen gekozen.
De rest mag je zelf doen

 

[CygneVoler]

Hartelijk dank ga er mee aan de slag. Mocht ik er niet uit komen dan meld ik me weer

 

[edmoor]

Graag gedaan.
En uiteraard

 

[CygneVoler]

Edmoor ik heb nog een vraag aan je: als ik nu twee x kopieer, wordt ook keurig twee x de tekst onder elkaar geplakt. Is het mogelijk dat als ik na de eerst x kopiëren een wit regel kan worden "ingevoegd"? Dan is het resultaat dus dat wanneer je twee x kopieert, er tussen de twee acties in een wit regel staat.

 

[edmoor]

Ja, dat kan. Wijzig dat dit:

        With bsto
            LRbsto = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        End With

in dit:

        With bsto
            LRbsto = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            If i = 3 And LRbsto > 3 Then LRbsto = LRbsto + 1
        End With

 

[CygneVoler]

Oke top dankjewel.

 

[CygneVoler]

Edmoor ik heb toch nog een vraag mbt Kopiëren en plakken in ander excel blad, waar je me ontzettend mee geholpen hebt. Als ik het blad "besteloverzicht" nu wil beveiligen (om te voorkomen dat er zaken in gewijzigd gaan worden) dan lukt het kopiëren niet meer. Nu kan ik "With sheets ("BestelOverzicht") .Unprotect invoegen en aan het einde weer .Proterct. Maar ik krijg steeds een fout melding. Kan jij me zeggen wat ik niet goed doe?

Private Sub CommandButton1_Click()
    Dim bstl As Worksheet
    Dim bsto As Worksheet
    Dim LRbstl As Long
    Dim LRbsto As Long
    Dim i As Long
    
    With bsto
    .Unprotect
    Set bstl = Sheets("Bestelling")
    Set bsto = Sheets("BestelOverzicht")
    
    With bstl 'Bestelling vanaf kolom B wordt gekeken naar de hoeveelheid tekst
        LRbstl = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    For i = 3 To LRbstl 'i = "cijfer" hiermee bepaal je de regel van waar af de eerste kopie wordt genomen
        With bsto
            LRbsto = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            If i = 3 And LRbsto > 3 Then LRbsto = LRbsto + 1 'zorgt voor extra witregel tussen de bestelling
        End With
        bsto.Cells(LRbsto, 2) = bstl.Cells(i, 2)
        bsto.Cells(LRbsto, 3) = bstl.Cells(i, 3)
        bsto.Cells(LRbsto, 4) = bstl.Cells(i, 4)
        bsto.Cells(LRbsto, 5) = bstl.Cells(i, 6)
        bsto.Cells(LRbsto, 6) = bstl.Cells(i, 7)
        bsto.Cells(LRbsto, 7) = bstl.Cells(i, 11)
        bsto.Cells(LRbsto, 8) = bstl.Cells(i, 12)
        bsto.Cells(LRbsto, 9) = bstl.Cells(i, 13)
    Next i
    
    End With
    .Protect
End Sub

 

[edmoor]

Als je zegt een foutmelding te krijgen is het ook de bedoeling dat je even laten weten welke melding dat dan precies is.

 

[CygneVoler]

Compileerfout: Ongeldige of niet gekwalificeerde verwijzing

 

[jolivanes]

De Protect staat niet tussen With....End With dus heeft geen punt (.) nodig.

 

[edmoor]

En je doet hier With bsto terwijl dit object pas later wordt aangemaakt:

    With bsto
    .Unprotect
    Set bstl = Sheets("Bestelling")
    Set bsto = Sheets("BestelOverzicht")

 

[CygneVoler]

Oke, dit is wat ik nu gedaan heb en dat werkt. Hoewel ik het idee heb dat het wat langzaam gaat?

Private Sub CommandButton1_Click()
    Dim bstlF As Worksheet
    Dim bsto As Worksheet
    Dim LRbstlF As Long
    Dim LRbsto As Long
    Dim i As Long
    
    
    Set bstlF = Sheets("Bestelformulier")
    Set bsto = Sheets("BestelOverzicht")
    
    With bstlF 'Bestelling vanaf kolom B wordt gekeken naar de hoeveelheid tekst
        LRbstlF = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
    
 
    For i = 3 To LRbstlF 'i = "cijfer" hiermee bepaal je de regel van waar af de eerste kopie wordt genomen
        With bsto
        .Unprotect ("test")
    
            LRbsto = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            If i = 3 And LRbsto > 3 Then LRbsto = LRbsto + 1 'zorgt voor extra witregel tussen de bestelling
                  
        bsto.Cells(LRbsto, 2) = bstlF.Cells(i, 2)
        bsto.Cells(LRbsto, 3) = bstlF.Cells(i, 3)
        bsto.Cells(LRbsto, 4) = bstlF.Cells(i, 4)
        bsto.Cells(LRbsto, 5) = bstlF.Cells(i, 6)
        bsto.Cells(LRbsto, 6) = bstlF.Cells(i, 7)
        bsto.Cells(LRbsto, 7) = bstlF.Cells(i, 11)
        bsto.Cells(LRbsto, 8) = bstlF.Cells(i, 12)
        bsto.Cells(LRbsto, 9) = bstlF.Cells(i, 13)
        
         .Protect ("test")
        End With
        
    Next i
  
End Sub

Ik hoor graag jullie reactie waarvoor alvast mijn hartelijke dank.

 

[edmoor]

Doe de protect en unprotect buiten de loop, dan zal het een stuk sneller gaan.

Private Sub CommandButton1_Click()
    Dim bstlF As Worksheet
    Dim bsto As Worksheet
    Dim LRbstlF As Long
    Dim LRbsto As Long
    Dim i As Long
    
    
    Set bstlF = Sheets("Bestelformulier")
    Set bsto = Sheets("BestelOverzicht")
    
    With bstlF 'Bestelling vanaf kolom B wordt gekeken naar de hoeveelheid tekst
        LRbstlF = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
    
    bsto.Unprotect ("test") 
    For i = 3 To LRbstlF 'i = "cijfer" hiermee bepaal je de regel van waar af de eerste kopie wordt genomen
        With bsto
            LRbsto = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            If i = 3 And LRbsto > 3 Then LRbsto = LRbsto + 1 'zorgt voor extra witregel tussen de bestelling
            bsto.Cells(LRbsto, 2) = bstlF.Cells(i, 2)
            bsto.Cells(LRbsto, 3) = bstlF.Cells(i, 3)
            bsto.Cells(LRbsto, 4) = bstlF.Cells(i, 4)
            bsto.Cells(LRbsto, 5) = bstlF.Cells(i, 6)
            bsto.Cells(LRbsto, 6) = bstlF.Cells(i, 7)
            bsto.Cells(LRbsto, 7) = bstlF.Cells(i, 11)
            bsto.Cells(LRbsto, 8) = bstlF.Cells(i, 12)
            bsto.Cells(LRbsto, 9) = bstlF.Cells(i, 13)
        End With
    Next i
    bsto.Protect ("test")
End Sub

 

[CygneVoler]

Edmoor bedankt voor je aanwijzing en tip. Heeft het nog zin om Application.ScreenUpdating = False toe te voegen aan de formule?

 

[edmoor]

Dat zal in dit geval niet nodig zijn, maar kwaad kan het ook niet.

 

[CygneVoler]

Iedereen bedankt voor zijn input en hulp!