Telefonszámunk: 1-472-0679

[Resolved] Egy cella tartalmának automatikus átmásolása egérkattintásra egy másik cellába

Kezdőlap Fórumok Excel témák [Resolved] Egy cella tartalmának automatikus átmásolása egérkattintásra egy másik cellába

Topic Resolution: Resolved

Ennek a témakörnek tartalma 3 hozzászólás, 2 résztvevő. Utolsó frissítés:  delila 1 hét, 3 napja telt el.

4 bejegyzés megtekintése - 1-4 / 4
  • Szerző
    Bejegyzés
  • #7136

    Attila1000
    Felhasználó

    Kedves excel Szakértő!
    Az alábbi excel probléma megoldásában kérném szíves segítségét, ha lehetséges.
    Megoldható-e excelben az, hogy a Munkalap1-en lévő terméklistában, egy tetszőleges cellára egérrel kattintva (pl. az A oszlopban lévő egyik cikkszámra), annak a tartalma automatikusan átmásolásra kerüljön egy másik munkalap (eddig üres) adott cellájába (pl. Munkalap2 – A1 cellába)? Tulajdonképpen olyanra lenne szükségem, mint a hivatkozás beszúrása opció a dokumentum adott pontjára cellahivatkozással, csak annyi különbséggel, hogy a Munkalap2 – A1 cellába a szöveg (cikkszám) is átmásolásra kerüljön ha rákattintok, ne csak a kurzor ugorjon oda.
    A lényeg tehát az lenne, hogy ha a Munkalap1-en lévő cikklista bármely cikkszámára rákattintok egérrel (mint egy hivatkozásra), akkor az automatikusan a Munkalap2-őn lévő A1-es cellára ugorjon a kurzor, és a kiválasztott cikkszám is átmásolásra kerüljön. Egy egyszerűsített excel munkafüzetet csatoltam.
    Előre is köszönöm a segítséget.
    Üdvözlettel:
    Attila

    #7137

    delila
    Felhasználó

    Szia Attila!

    Lemaradt a csatolás, de nem baj.
    Két makrót írtam. Az elsőt a Munka1 laphoz kell rendelned (lapfülön jobb klikk, Kód megjelenítése. Ezzel beléptél a VB szerkesztőbe. Bal oldalon látod a füzeted nevét, azon belül a Munka1 lapot. A jobb oldalon lévő üres területre kell bemásolnod a lenti kódot):

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        Dim ide As Long
    
        If Target.Column = 1 Then
            Cells(Target.Row, 1).Copy Sheets("Munka2").Cells(1)
            ugras
        End If
    End Sub

    A másik makró modulba kerül. A VB szerkesztőben a füzeteden állva Insert menü, Module. Erre kapsz egy Module1 nevű modult, jobb oldalra másold a makrót:

    Sub ugras()
        Sheets("Munka2").Select
        Cells(1).Select
    End Sub

    Ezután visszatérve a füzetedbe, a Munka1 lap A oszlopában bármelyik cellán duplakikk, a Munka2 A1 cellájában megjelenik a kiválasztott cikkszám, a Munka2 lesz aktív, ott is az A1 cella.
    _________________________________________________________________________________________________________________________________________

    Előfordulhat, hogy a kiválasztott cikkszámokat a Munka2 lapon egymás alá szeretnéd átvinni, mindig az első üres sorba. Ebben az esetben a laphoz ez jön:

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        Dim ide As Long
    
        If Target.Column = 1 Then
            ide = Sheets("Munka2").Range("A" & Rows.Count).End(xlUp).Row + 1
            Cells(Target.Row, 1).Copy Sheets("Munka2").Cells(ide, 1)
            ugras ide
        End If
    End Sub

    … a modulba pedig:

    Sub ugras(ide)
        Sheets("Munka2").Select
        Cells(ide,1).Select
    End Sub

    Vagy az egyik, vagy a másik párost másold be a Vb szerkesztőbe.

    Üdv,
    Kati

    • A hozzászólás módosításra került: 1 hét, 4 napja telt el- delila. Indok: Javítás
    • A hozzászólás módosításra került: 1 hét, 4 napja telt el- delila.
    #7141

    Attila1000
    Felhasználó

    Kedves Kati!
    Nagyon szépen köszönöm a segítséget, tökéletesen működik! 🙂
    Üdv,
    Attila

    #7142

    delila
    Felhasználó

    Örülök, hogy összejött.

4 bejegyzés megtekintése - 1-4 / 4

Be kell jelentkezni a hozzászóláshoz.