Kopieren naar ander werkblad + verplaatsen cellen.

[Rnie]

Hallo,

Ik heb het volgende probleem.

Ik heb twee werkbladen en zou graag de waarden van "blad1" willen kopieren naar "blad2" alleen stuit ik tegen het volgende probleem aan.
Op "blad1" wil ik bijvoorbeeld de cellen A1, B1 en G1 kopieren naar "blad2". Maar dan moeten ze op “blad2” in de cellen A1, B1 en C1 komen te staan. Kortom: cel G1 op “blad1” wordt cel C1 op “blad2”. Of anders gezegd: op “blad2” moeten de waarden gewoon achter elkaar komen te staan. De waarden tussen cel B1 en G1 mogen niet mee worden gekopieerd.

Nu heb ik een bestand met een hele hoop regels en elke keer als ik op een willekeurige regel van “blad1” klik moet deze gekopieerd worden naar “blad2”.

Ik kom echt niet verder dan onderstaande code. Nu word elke keer dezelfde waarden naar “blad2” gekopieerd.

    Range("A1,B1,G1").Select
    Range("G1").Activate
    Selection.Copy
    Sheets("Blad2").Select
    Range("A10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A11").Select

Groet,
Rnie

 

[Mark xl]

Beste Rnie,

probeer het zo eens:

ik gebruik variabele rgl om de rij van de huidige cel in op te slaan.
Daarna kopieer ik de cellen A, B en G van Blad1 naar Blad2

Sub verplaatsregel()
Dim rgl As Long
Dim rDoel As Range

If ActiveSheet.Name = "Blad1" Then

    rgl = ActiveCell.Row
    
    Set rDoel = Sheets("Blad2").Range("A" & rgl & ":C" & rgl)
    
    Union(Range("A" & rgl), _
          Range("B" & rgl), _
          Range("G" & rgl)).Copy Destination:=rDoel

End If

End Sub

 

[Rnie]

Mark,

Thanx voor de code maar deze werkt niet helemaal zoals ik bedoel. Ben misschien wat onduidelijk geweest. Ik wil dat, wanneer ik de eerste regel naar "blad2" kopieer naar bv. regel 10 direct eronder de volgende regel word gezet. Bij jou code worden er regels overgeslagen. En verder wil ik alleen de waarden (zonder de opmaak dus). Vandaar dat ik in mijn eigen code "pastespecial" had.

Maar ik ga eens verder borduren op jou code.

Groet,
Rnie

 

[Mark xl]

Hoi Rnie,

Dat dacht ik eerlijk gezegd al

Ik kopieer nu alléén de waarden van de rij van blad1 naar blad2

Sub verplaatsregel()
Dim rgl As Long
Dim vTest As Variant

If ActiveSheet.Name = "Blad1" Then
    
    rgl = ActiveCell.Row
    
    vTest = Array(Range("A" & rgl).Value, _
                    Range("B" & rgl).Value, _
                    Range("G" & rgl).Value)
    
    Sheets("Blad2").Range("A65535").End(xlUp).Offset(1).Resize(, 3) = vTest

End If

End Sub

Sub verplaatsregel()
Dim rgl As Long
Dim rDoel As Range

If ActiveSheet.Name = "Blad1" Then

    rgl = ActiveCell.Row
    
    [B][COLOR="red"]Set rDoel = Sheets("Blad2").Range("A65535").end(xlup).offset(1)[/COLOR][/B]
    
    Union(Range("A" & rgl), _
          Range("B" & rgl), _
          Range("G" & rgl)).Copy Destination:=rDoel

End If

End Sub

 

[Rnie]

Hoi Rnie,

Dat dacht ik eerlijk gezegd al

Ik kopieer nu alléén de waarden van de rij van blad1 naar blad2

Sub verplaatsregel()
Dim rgl As Long
Dim vTest As Variant

If ActiveSheet.Name = "Blad1" Then
    
    rgl = ActiveCell.Row
    
    vTest = Array(Range("A" & rgl).Value, _
                    Range("B" & rgl).Value, _
                    Range("G" & rgl).Value)
    
    Sheets("Blad2").Range("A65535").End(xlUp).Offset(1).Resize(, 3) = vTest

End If

End Sub

Deze werkt prima alleen had ik gedacht dat code zo was dat ik zelf een beetje kan aanpassen maar dit lukt niet. De volgende onderdelen snap ik nu:

Range("A65535") = In welke kolom er gestart moet worden.
Offset(1) = start volgende regel.
Resize(, 3) = Hoeveel waarden er naar ander blad moet worden gekopieerd.

Maar stel dat ik bv een kolom over wil slaan tussen kolom A en B in "blad2". Dan zat ik zelf te denken dat ik nog iets moet doen met "End(xlUp)". (Dus kolom A, B en G van "blad1" worden nu gekopieert naar kolom A,C en D van "blad2").
Als dat niet gaat, ga ik met jou formule verder want die werkt verder prima op die kleine opmerking na.

Groet,
Rnie

 

[Mark xl]

Beste Rnie,

Ik denk dat je er ook wat van wil leren, dus ik denk dat ik je wellicht beter help met een toegankelijkere Macro. Ik probeer altijd performance zo hoog mogelijk te houden, maar in dit geval is dat absoluut verwaarloosbaar.

Probeer onderstaande code eens uit. deze doet hetzelfde, en ik denk dat je deze snapt en zelf kunt uitbreiden.

Mocht je het volgende nog niet weten: stap door je macro met F8, en houd je muis boven de variabelen om de waarden te zien die ze bevatten

Sub Verplaatsregel2()
Dim rgl As Long         'een variabele om de rij van de huidge cel in op te slaan
Dim rglBlad2 As Long    'een variabele om de laatste rij van blad2 in op te slaan
    
    If ActiveSheet.Name = "Blad1" Then
    
        rgl = ActiveCell.Row    'rij van huidige cel aabn variabele toewijzen
            
        With Sheets("Blad2")
        
            rglBlad2 = .Range("A65535").End(xlUp).Offset(1, 0).Row 'rij eerstvolgende cel
            
            .Range("A" & rglBlad2) = Sheets("Blad1").Range("A" & rgl).Value
            .Range("B" & rglBlad2) = Sheets("Blad1").Range("B" & rgl).Value
            .Range("D" & rglBlad2) = Sheets("Blad1").Range("G" & rgl).Value
        
        End With
    
    End If
    
End Sub