Risolto clicca su cella numero e cella copia

marxitpa

Utente abituale
11 Novembre 2017
410
18
gallarate
excel 2007
9
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.
 

Allegati

Marco Lauria

Utente assiduo
2 Gennaio 2017
1.157
95
Roma
www.artigianamaterassi.net
Excel 2016
122
Se ho ben capito prova una cosa del genere:

Visual Basic:
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

Utente abituale
11 Novembre 2017
410
18
gallarate
excel 2007
9
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:

Visual Basic:
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
 

Allegati

Ultima modifica:

marxitpa

Utente abituale
11 Novembre 2017
410
18
gallarate
excel 2007
9
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

Utente abituale
Expert
19 Gennaio 2021
210
30
Office e VBA
31
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
 

Allegati

  • Like
Reactions: Rubik72

TheTruster

Utente abituale
Expert
19 Gennaio 2021
210
30
Office e VBA
31
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.

Visual Basic:
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

Utente abituale
29 Settembre 2019
590
30
Torino
Excel 2007
41
Prova questa macro, l'ho buttata giù velocemente usando una cella d'appoggio
Visual Basic:
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

Utente abituale
29 Settembre 2019
590
30
Torino
Excel 2007
41
Con questa piccola modifica eviti che il dato venga sempre ricopiato (lo ricopia una volta sola)

Visual Basic:
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
 
  • Like
Reactions: marxitpa

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!