selectie gegevens kopieren

[Exceldummie]

Ik heb een bestand (zie bijlage), waar op het tabblad registratie dagelijks nieuwe regels worden toegevoegd. Nu wil ik graag de gegevens van kolom A-L kopieren naar tab "verwijzing 1" zodra in de kolom M een x wordt geplaatst.
Indien in kolom N een x wordt geplaatst moet de gegevens van kolom A-L naar tab "verzijzing 2".

Hiervoor wil ik geen formules gebruiken i.v.m. het mailen van het betreffende tabblad. Ook dienen de regels waar geen x wordt geplaatst niet (leeg) overgenomen te worden. Wie weet een macro of een andere tip?

Alvast bedankt!

 

[Roncancio]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRij As Long
If Target.Value = "x" and Target.Column>=13 and Target.Column<=14 Then
    Worksheets("registratie").Range("A" & Target.Row & ":L" & Target.Row).Copy
    lRij = Worksheets("verwijzing " & Target.Column - 12).Range("A65536").End(xlUp).Row + 1
    Worksheets("verwijzing " & Target.Column - 12).Range("A" & lRij).PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
End If
End Sub

Bovenstaande code wordt geactiveerd zodra er een x wordt geplaatst in de M-kolom of N-kolom van registratie.
Bij een x in de M-kolom worden de reeks van de kolommen A t/m L van die regel in verwijzing 1 geplaatst.
Bij een x in de N-kolom worden de reeks van de kolommen A t/m L van die regel in verwijzing 2 geplaatst.

Let op de namen van de werkbladen. Zorg dat die overeenkomt met die in de code.

Met vriendelijke groet,


Roncancio

 

[Exceldummie]

het gaat niet OK

Ik krijg een foutmelding in de regel 1rij = .....

Klopt er iets niet of doe ik het fout??

 

[Roncancio]

Ik krijg een foutmelding in de regel 1rij = .....

Klopt er iets niet of doe ik het fout??

Ik denk dat dat komt omdat de namen van de werkbladen niet overeenkomen met die in de code.
Ik ben uitgegaan van verwijzing 1, verwijzing 2 (dus met een spatie voor het getal).
Anders moet je even doorgeven wat de exacte benamingen zijn.

Met vriendelijke groet,


Roncancio

 

[Exceldummie]

Het is dus complexer dan ik dacht. Zoals je wellicht door had is het voorbeeldbestand een dummy. Ik dacht dat ik de code wel even kon aanpassen, viel tegen

Het gaat om de volgende bewerking:
x in kolom M op tabblad "registratie"-> kopie kolom A-I naar tab "Rabo"
x in kolom N op tabblad "registratie" -> kopie kolom A-E + H naar tab "Postma"
x in kolom O op tabblad "registratie" -> kopie kolom A-E + H naar tab "Procee"

Ik hoop dat je kunt helpen. De voorbeelduitwerking werkt OK

 

[Roncancio]

Het is dus complexer dan ik dacht. Zoals je wellicht door had is het voorbeeldbestand een dummy. Ik dacht dat ik de code wel even kon aanpassen, viel tegen

Het gaat om de volgende bewerking:
x in kolom M op tabblad "registratie"-> kopie kolom A-I naar tab "Rabo"
x in kolom N op tabblad "registratie" -> kopie kolom A-E + H naar tab "Postma"
x in kolom O op tabblad "registratie" -> kopie kolom A-E + H naar tab "Procee"

Ik hoop dat je kunt helpen. De voorbeelduitwerking werkt OK

Ik dacht 'slim' te zijn door de namen van de tabbladen te combineren zodat er weinig code nodig is.
Ik heb de code aangepast volgens je laatste mailtje.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRij As Long
If Target.Value = "x" And Target.Column >= 13 And Target.Column <= 15 Then
    Worksheets("registratie").Range("A" & Target.Row & ":I" & Target.Row).Copy
    Select Case Target.Column
        Case 13
            Worksheets("registratie").Range("A" & Target.Row & ":I" & Target.Row).Copy
            lRij = Worksheets("Rabo").Range("A65536").End(xlUp).Row + 1
            Worksheets("Rabo").Range("A" & lRij).PasteSpecial Paste:=xlPasteAll
        Case 14
            Worksheets("registratie").Range("A" & Target.Row & ":E" & Target.Row).Copy
            lRij = Worksheets("Postma").Range("A65536").End(xlUp).Row + 1
            Worksheets("Postma").Range("A" & lRij).PasteSpecial Paste:=xlPasteAll
            Worksheets("Postma").Range("H" & lRij).Value = Worksheets("registratie").Range("H" & Target.Row).Value
        Case 15
            Worksheets("registratie").Range("A" & Target.Row & ":E" & Target.Row).Copy
            lRij = Worksheets("Procee").Range("A65536").End(xlUp).Row + 1
            Worksheets("Procee").Range("A" & lRij).PasteSpecial Paste:=xlPasteAll
            Worksheets("Procee").Range("H" & lRij).Value = Worksheets("registratie").Range("H" & Target.Row).Value
    End Select
    Application.CutCopyMode = False
End If
End Sub

Als er nog problemen blijven dan hoor ik het wel.

Met vriendelijke groet,


Roncancio