Problema macro copiaincolla

Hai un problema con Excel?

Nuova discussione

Problema macro copia-incolla
di azalyn (utente non iscritto) data: 15/07/2015 11:51:24
Ho un problema con delle macro che mi dovrebbero fare un copia-incolla di una tabellina non tanto elaborata.
Le celle sono B3:L8, ogni colonna contiene dei valori che ad ogni tot vengono incrementati a scelta dell'utente, facendo riferimento ad una cella specifica in un altro foglio. Non avendo conoscenze di base di VBA o di ogni altro tipo di linguaggio informatico, mi sono affidato a persone esterne che mi hanno fatto l'impostazione della macro. Ho aggiunto altre 10 macro sullo stesso foglio, cambiando il nome da Private Sub Worksheet_Change(ByVal Target As Range) a Private Sub Worksheet_Change2(ByVal Target As Range)e cosi via e anche il nome della Tab in ogni macro. Quando inserisco i valori nelle altre colonne mi continua a dare problemi di runtime con codice 91 dicendomi "variabile oggetto o variabile del blocco with non impostata" selezionandomi la stringa If Not Application.Intersect(Target, Range(myTab1)) And Sheets("Barbaro").Range("D14").Value < 2 Then solo della prima macro. Non so piu come risolvere questo problema

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTab1 As String
'
myTab1 = "B3:B8"
'
If Not Application.Intersect(Target, Range(myTab1)) And Sheets("Barbaro").Range("D14").Value < 2 Then
        Range(myTab1).Copy Destination:=Sheets("test").Range("AAA1")
        
End If
End Sub

di alfrimpa data: 15/07/2015 12:13:02
Ciao Azalyn

Solo una notazione (ora sono fuori sede senza pc): non può esistere una macro denominata Worksheet_Change2()

Worksheet_Change() è unica ed il suo codice viene eseguito ad ogni variazione "fisica" del foglio di lavoro.

Alfredo
di azalyn (utente non iscritto) data: 15/07/2015 12:24:13
per bypassare il problema del intestazione posso mettere Private Sub 2_Worksheet_Change(ByVal Target As Range)?
di alfrimpa data: 15/07/2015 12:27:25
No come ti ho detto Worksheet_Change() è e deve essere unica.

È al suo interno che va gestita la situazione.

Alfredo
di Vecchio Frac data: 15/07/2015 13:50:04
cit. " non può esistere una macro denominata Worksheet_Change2() "
---> Alfredo intende dire che l'evento che si scatena quando cambi il contenuto di una cella del foglio è gestito da Excel e ha la firma standard "Private Sub Worksheet_Change(ByVal Target As Range)" e non può essere modificata altrimenti non è più l'evento di cui si tratta; ma può naturalmente benissimo coesistere una sub dal nome ambiguo "Worksheet_Change2()" che però non viene invocata automaticamente eccetera ma deve essere chiamata espressamente dal programmatore.
Certamente quello che ha fatto azalyn ("Ho aggiunto altre 10 macro sullo stesso foglio, cambiando il nome da Private Sub Worksheet_Change(ByVal Target As Range) a Private Sub Worksheet_Change2(ByVal Target As Range)e cosi via") lo porta fuori strada perchè non fa quello che lui si aspetta di ottenere.
di alfrimpa data: 15/07/2015 14:00:41
Grazie VF precisazione più che opportuna.

Sono sulla spiaggia e con il cell non è facile dilungarsi

Alfredo

di Azalyn data: 15/07/2015 14:08:45
Quindi posso benissimo mantenere l'impostazione del sub uguale ma cambiare sotto in, senza che mi dia problemi?

Dim myTab1 As String
'
myTab1 = "B3:B8"
'
If Not Application.Intersect(Target, Range(myTab1)) And Sheets("Barbaro").Range("D14").Value < 2 Then
        Range(myTab1).Copy Destination:=Sheets("test").Range("AAA1")
__ 
Dim myTab2 As String
'
myTab2 = "C3:C8"
'
If Not Application.Intersect(Target, Range(myTab2)) And Sheets("Bardo").Range("D14").Value < 2 Then
        Range(myTab2).Copy Destination:=Sheets("test").Range("AAb1")

di Vecchio Frac data: 15/07/2015 16:55:28
alfrimpa
cit. "Sono sulla spiaggia"
---> Beato te ^_^
di Vecchio Frac data: 15/07/2015 17:02:22
@azalyn
Manca un "Is Nothing" nel test di quegli if: devi testare se la cella modificata interseca il range dato e devi dirglielo nel suo linguaggio (If Not Application.Intersect(...) is Nothing And Sheets("Barbaro")... < 2 Then ).
In teoria comunque sembra che possa funzionare, premesso che devi anche disabilitare gli eventi cioè Application.EnableEvents = False a inizio sub (e True a fine sub) del Worksheet_Change, per evitare la ricorsione.

Poi sai, a pezzi e bocconi sembra anche che fili liscio ma bisognerebbe vedere tutto il contesto.
Barbari, bardi... sembra che stai trattando un RPG ^_^
di Azalyn data: 15/07/2015 17:15:11
sto facendo una scheda su excel di D&D

di Azalyn data: 15/07/2015 17:32:12
Grazie per l'aiuto ora la mega macro funziona perfettamente eccola sistemata, spero.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTab1 As String
'
myTab1 = "B3:B8"
'
If Not Application.Intersect(Target, Range(myTab1)) Is Nothing And Sheets("Barbaro").Range("D14").Value < 2 Then
        Range(myTab1).Copy Destination:=Sheets("test").Range("AAA1")
        
End If

Dim myTab2 As String
'
myTab2 = "C3:C8"
'
If Not Application.Intersect(Target, Range(myTab2)) Is Nothing And Sheets("Bardo").Range("D14").Value < 2 Then
        Range(myTab2).Copy Destination:=Sheets("test").Range("AAB1")
        
End If
Dim myTab3 As String
'
myTab3 = "D3:D8"
'
If Not Application.Intersect(Target, Range(myTab3)) Is Nothing And Sheets("Chierico").Range("D14").Value = 1 Then
        Range(myTab3).Copy Destination:=Sheets("test").Range("AAC1")
        
End If
Dim myTab4 As String
'
myTab4 = "E3:E8"
'
If Not Application.Intersect(Target, Range(myTab4)) Is Nothing And Sheets("Druido").Range("D14").Value = 1 Then
        Range(myTab4).Copy Destination:=Sheets("test").Range("AAD1")
        
End If
Dim myTab5 As String
'
myTab5 = "F3:F8"
'
If Not Application.Intersect(Target, Range(myTab5)) Is Nothing And Sheets("Guerriero").Range("D14").Value = 1 Then
        Range(myTab5).Copy Destination:=Sheets("test").Range("AAE1")
        
End If
Dim myTab6 As String
'
myTab6 = "G3:G8"
'
If Not Application.Intersect(Target, Range(myTab6)) Is Nothing And Sheets("Ladro").Range("D14").Value = 1 Then
        Range(myTab6).Copy Destination:=Sheets("test").Range("AAF1")
        
End If
Dim myTab7 As String
'
myTab7 = "H3:H8"
'
If Not Application.Intersect(Target, Range(myTab7)) Is Nothing And Sheets("Mago").Range("D14").Value = 1 Then
        Range(myTab7).Copy Destination:=Sheets("test").Range("AAG1")
        
End If
Dim myTab8 As String
'
myTab8 = "I3:I8"
'
If Not Application.Intersect(Target, Range(myTab8)) Is Nothing And Sheets("Monaco").Range("D14").Value = 1 Then
        Range(myTab8).Copy Destination:=Sheets("test").Range("AAH1")
        
End If
Dim myTab9 As String
'
myTab9 = "J3:J8"
'
If Not Application.Intersect(Target, Range(myTab9)) Is Nothing And Sheets("Paladino").Range("D14").Value = 1 Then
        Range(myTab9).Copy Destination:=Sheets("test").Range("AAI1")
        
End If
Dim myTab10 As String
'
myTab10 = "K3:K8"
'
If Not Application.Intersect(Target, Range(myTab10)) Is Nothing And Sheets("Ranger").Range("D14").Value = 1 Then
        Range(myTab10).Copy Destination:=Sheets("test").Range("AAJ1")
        
End If
Dim myTab11 As String
'
myTab11 = "L3:L8"
'
If Not Application.Intersect(Target, Range(myTab11)) Is Nothing And Sheets("Stregone").Range("D14").Value = 1 Then
        Range(myTab11).Copy Destination:=Sheets("test").Range("AAK1")
        
End If
End Sub

di Vecchio Frac data: 16/07/2015 08:31:27
cit. "sto facendo una scheda su excel di D&D"
---> ci ho preso ^_^ giocavo anch'io qualche anno fa. Perdevo sempre, povero maghetto :P

La macro scritta così magari funziona, si può migliorare.
- non hai disabilitato/riabilitato gli eventi come ti ho detto, male, rimedia subito :)
- metti tutti i Dim a inizio codice, dopo la definizione della Sub (tutto il mondo fa così, ci adeguiamo alla convenzione ^_^)
- riscrivi la Sub ripensandola per quello che fa, aggregando i Range interessati e sfruttando Select Case per riorganizzare il codice.

di Vecchio Frac data: 16/07/2015 08:52:02
Alla fine si può fare anche senza Select Case :)

edit: piccola integrazione (perchè tu volevi ricopiare l'intero range es. B3:B8 e non solo il dato inserito.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range, c As Range
    
    Application.EnableEvents = False

    Set myRange = Range("b3:b8, c3:c8, d3:d8, e3:e8, f3:f8, g3:g8, h3:h8, i3:i8, j3:j8, k3:k8, l3:l8")

    Set c = Application.Intersect(Target, myRange)
    If Not c Is Nothing And Sheets("Barbaro").Range("D14").Value < 2 Then
        'ricopia i dati in foglio test, da AAA1 in poi
        'c.Copy Sheets("test").Cells(1, 701 + c.Column)      'ricopia singolo dato appena inserito                
        myRange.Areas(c.Column - 1).Copy Sheets("test").Cells(1, 701 + c.Column)  'copia range es B3:B8

    End If
    
    Application.EnableEvents = True
End Sub

Vuoi Approfondire?