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 › Hozzászólás: [Resolved] Egy cella tartalmának automatikus átmásolása egérkattintásra egy másik cellába
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