Risolto clicca su cella numero e cella copia

[marxitpa]

Nel file allegato, cliccando due volte in una cella contenente un numero, posso farlo copiare in altra cella ... rispondendo ad InputBox.
Cosa vorrei ottenere: cliccare una volta sul numero e una volta su cella dove copiare senza messaggio InputBox.

 

[Powerwin]

Ciao, se la cella di destinazione è sempre la stessa non serve infatti la Inputbox ma temo che non sia così

 

[Marco Lauria]

Se ho ben capito prova una cosa del genere:

Option Explicit

Dim Numero As Variant
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Numero = 0 Then
        Numero = Target
    Else
        Target = Numero
    End If
End Sub

 

[marxitpa]

trovato e adattato in parte questo codice e sembra funzionare quando i numeri da inserire sono in ordine crescente o decrescente fino a riga 11:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim x, y As Integer
x=21
    c = 2: r = 5
    While Cells(r, c) <> ""
        c = c + 1
        If c = x Then c = 2: r = r + 6
    Wend
    Cells(r, c) = ActiveCell

Cancel = True
End Sub

Esigenza:
- fare in modo che ci sia un solo Click;
- nelle righe (17-19-37-39) dove sono da inserire i numeri pari o dispari venga ridotto il 'If c = 21 Then

Intendo procedere così: faccio contare in riga 15 i numeri pari e i dispari e quando considero i relativi inserimenti modificare il valore di x

 

[Marco Lauria]

Ma hai letto il mio post????

 

[marxitpa]

Si Marco Lauria ma non mi funziona ...

 

[Marco Lauria]

a me si perfettamente
clicchi su cella con numero e poi su cella di destinazione

 

[Marco Lauria]

Non devi fare doppio click ma solo posizionarti su cella 1 e poi cella 2

 

[marxitpa]

vero Marco Lauria funziona ...
Avevo inserito il tuo codice assieme al mio ed entravano in conflitto

Attento però ... quando vado a selezionare altro numero (o altra cella) viene incollato il precedente

 

[TheTruster]

Ciao,
Ho perso un po' di tempo nelle prove e forse hai già trovato la soluzione, ma ti posto comunque il mio risultato.

Si fa un doppio click sulla cella da copiare e un doppio click sulla cella di destinazione.

TheTruster

 

[marxitpa]

TheTruster funziona ... ma fare limitare l'incolla alle colonne B:T e righe interessate?

 

[TheTruster]

TheTruster funziona ... ma fare limitare l'incolla alle colonne B:T e righe interessate?
Ed anora: potresti migliorare facendo in modo che dopo avere copiato la cella da copiare ... la faccia colorare in giallo?

Si, si può fare.
Cambia il codice della routine con quello che segue.
Per adattarlo ad altri ranges, basta scrivere le celle nelle variabili, così come ho fatto io.
SourceRange sono le celle da copiare, DestRange sono le celle di destinazione.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Static SourceCell As Range
Dim CheckRange As String
Static sValue As String

Cancel = True

SourceRange = "|B3|D3|F3|H3|J3|L3|N3|P3|R3|T3|" & _
            "B9|D9|F9|H9|J9|L9|N9|P9|R9|T9|" & _
            "B15|D15|F15|H15|J15|L15|N15|P15|R15|T15|" & _
            "B19|D19|F19|H19|J19|L19|N19|P19|R19|T19|" & _
            "B23|D23|F23|H23|J23|L23|N23|P23|R23|T23|" & _
            "B29|D29|F29|H29|J29|L29|N29|P29|R29|T29|" & _
            "B35|D35|F35|H35|J35|L35|N35|P35|R35|T35|"

DestRange = "|B5|D5|F5|H5|J5|L5|N5|P5|R5|T5|" & _
            "B11|D11|F11|H11|J11|L11|N11|P11|R11|T11|" & _
            "B17|D17|F17|H17|J17|L17|N17|P17|R17|T17|" & _
            "B19|D19|F19|H19|J19|L19|N19|P19|R19|T19|" & _
            "B25|D25|F25|H25|J25|L25|N25|P25|R25|T25|" & _
            "B31|D31|F31|H31|J31|L31|N31|P31|R31|T31|" & _
            "B37|D37|F37|H37|J37|L37|N37|P37|R37|T37|" & _
            "B39|D39|F39|H39|J39|L39|N39|P39|R39|T39|"


If Not bCopying Then
    If InStr(1, SourceRange, "|" & Replace(Target.Address, "$", "") & "|") > 0 Then
        Target.Copy
        bCopying = True
        Set SourceCell = Target
    End If
Else
    If InStr(1, DestRange, "|" & Replace(Target.Address, "$", "") & "|") > 0 Then
        Target.Value = SourceCell.Value
        SourceCell.Interior.Color = vbYellow
        bCopying = False
        Application.CutCopyMode = False
    End If
End If

End Sub

TheTruster

 

[Lucastar]

Prova questa macro, l'ho buttata giù velocemente usando una cella d'appoggio

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Selection.Value <> "" Then
Range("AB1").Value = Selection.Value
Else
Selection.Value = Range("AB1")
End If
End Sub

 

[Lucastar]

Con questa piccola modifica eviti che il dato venga sempre ricopiato (lo ricopia una volta sola)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Selection.Value <> "" Then
Range("AB1").Value = Selection.Value

Else
Selection.Value = Range("AB1").Value
Range("AB1").Clear
End If
End Sub