trovato mancava un ultimo end if alla fine
inoltre in copio in filtra c'e una riga che penso si possa migliorare
ma non so come.
questo il cod attuale funzionante.
- Codice: Seleziona tutto
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C:C,G:G,e:e")) Is Nothing Then
Dim UR As Long 'scegli la colonna
ActiveSheet.Unprotect
If Not Intersect(Target, Range("C:C")) Is Nothing Then
If Target = "" Then
MsgBox "La cella selezionata non contiene dati", vbCritical
Else
'------copio in bolla---------------
riga = Target.Row
Range("B" & riga & ":" & "W" & riga).Copy
Sheets("bolla").Select
ActiveSheet.Unprotect
UR = Sheets("bolla").Range("B" & Rows.Count).End(xlUp).Row + 1 'prima riga libera
If UR < 6 Then UR = 7 'a partire dalla riga 7
Sheets("bolla").Cells(UR, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Else
If Not Intersect(Target, Range("e:e")) Is Nothing Then
If Target = "" Then
MsgBox "La cella selezionata non contiene dati", vbCritical
Else
'------copio in filtra---------------
riga = Target.Row
Range("e" & riga & ":" & "e" & riga).Copy ' <<< si puo migliorare!!
Sheets("filtra").Select
ActiveSheet.Unprotect
If UR < 6 Then UR = 5 'a partire dalla riga 5
Sheets("filtra").Cells(5, 30).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Else
'---copio diario--------------------
If Target = "" Then
MsgBox "La cella selezionata non contiene dati", vbCritical
Else
riga = Target.Row
Range("C" & riga & ":" & "L" & riga).Copy
Sheets("diario").Select
ActiveSheet.Unprotect
UR = Sheets("diario").Range("C" & Rows.Count).End(xlUp).Row + 1 'prima riga libera
If UR < 6 Then UR = 7 'a partire dalla riga 7
Sheets("diario").Cells(UR, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
End If
End If '<<< mancava questo
Application.CutCopyMode = False
Sheets("prono").Select
Range("A1").Select
Else
MsgBox vbNewLine & vbNewLine & _
"Puoi fare 'Doppio Clik' solo :" & vbNewLine & vbNewLine & _
"in 'Data' ===> Col 'C' che copia in 'Bolla'" & vbNewLine & vbNewLine & _
"oppure" & vbNewLine & vbNewLine & _
"in 'Squadra casa' ===>Col 'G' che copia in 'Diario'", vbInformation
End If
Cancel = True
End Sub
