[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

• A hozzászólás módosításra került: 4 years, 6 months telt el-delila. Indok: Javítás
• A hozzászólás módosításra került: 4 years, 6 months telt el-delila.

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

Szia!

Modulba másold az alábbi 3 sort – feljebb látod a leírását.
A lapoknak önkényesen adtam Augusztus, ill. Szeptember nevet. Ezek helyére írd a saját lapjaid nevét.

Sub Masol()
    Sheets("Augusztus").Range("B3:B12").Copy Sheets("Szeptember").Range("B18")
End Sub

Üdv,
Kati