Esplosione codice articolo

Hai un problema con Excel?

Nuova discussione

Esplosione codice articolo
di Nicola (utente non iscritto) data: 21/01/2014 12:57:40
Esplosione codice articolo (excel 2010) di Nicola (Utente non iscritto) data: 21/01/2014 09:54:35

Salve a tutti è complimenti per il forum.

Ho un problema e non so come poterlo arginare .
Ho creato con vba per xls una tabella dove gestisco il piano promozionale degli articoli che vendo.
Attrasverso un db in xls dove ho la scheda anagrafica dell'articolo, mi prendo il codice e in automatico mi inserisce tutti i dati relativi al prodotto e fino a qui tutto bene.
Il mio problema è che ad ogni codice è legato un codice gruppo ES.
Cod gruppo codice singolo
000090 000020
000090 000030
000090 000040

Notate che il codice singolo è legato ade un codice capo gruppo.

Vorrei attraverso codice vba inserire nella mia tabella promozionale il codice capo gruppo ossia "000090"
è in automatico mi esplodesse in verticale gli articoli singoli legati ad esso ossia "000020";"000030";"000040".
Spero di essere stato abbastanza chiaro ....
Vi ringrazio aticipatamente

Il codice vba è QUELLO CHE USO PER IL PIANO PROMOZIONALE

Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   Dim strCellaModificata As String
   Dim strColonna As String
   Dim strRiga As String
   Dim intrisposta As Integer
   Dim y As Integer
   Dim blnTrovato As Boolean
   Dim strWorkbook As String
   

   
   blnTrovato = False
   
   Const conPercorso = "C:UsersPc_InfovisionDesktopvba"
   'quando si verifica un cambiamento(change) chiedo ad excel di memorizzare in target.adress il range modificato
   'nella variabile strcellamodificata
   
   strCellaModificata = Target.Address
 
strWorkbook = ActiveWorkbook.Name

       
   'verifico se è stata modificata una sola cella per volta oppure un intervallo di celle
   
 If Range(strCellaModificata).Count > 1 Then
   Exit Sub
 End If

   'nella variabile strcolonna memorizzo il valore della proprietà colum ossia la posizione della colonna
   strColonna = Range(strCellaModificata).Column
   
   strRiga = Range(strCellaModificata).Row
'se vi è una modifica nella colonna d dalla riga 7 apro il percorso al database in sola lettura

If strColonna = 2 And strRiga >= 9 Then
   Workbooks.Open Filename:=conPercorso & "dbnew.xlsx", ReadOnly:=True
  'ora attivo con il metodo activate il modulo promo
 
    Workbooks(strWorkbook).Activate
    y = 1
    
    Do Until blnTrovato = True Or y = 43000
    If UCase(Range(strCellaModificata)) = UCase(Workbooks("dbnew.xlsx").Worksheets("db").Range("A" & y)) Then
      
     Range(strCellaModificata).Offset(0, 7) = Workbooks("dbnew.xlsx").Worksheets("db").Range("B" & y)
     Range(strCellaModificata).Offset(0, 4) = Workbooks("dbnew.xlsx").Worksheets("db").Range("d" & y)
     Range(strCellaModificata).Offset(0, 1) = Workbooks("dbnew.xlsx").Worksheets("db").Range("e" & y)
     Range(strCellaModificata).Offset(0, 5) = Workbooks("dbnew.xlsx").Worksheets("db").Range("f" & y)
     Range(strCellaModificata).Offset(0, 6) = Workbooks("dbnew.xlsx").Worksheets("db").Range("g" & y)
     Range(strCellaModificata).Offset(0, 8) = Workbooks("dbnew.xlsx").Worksheets("db").Range("h" & y)
     Range(strCellaModificata).Offset(0, 8).Select
     Selection.NumberFormat = "$* #,##0.00"
     Range(strCellaModificata).Offset(0, 13) = Workbooks("dbnew.xlsx").Worksheets("db").Range("i" & y)
     Range(strCellaModificata).Offset(0, 13).Select
     Selection.NumberFormat = "$* #,##0.00"
     Range(strCellaModificata).Offset(0, 19) = Workbooks("dbnew.xlsx").Worksheets("db").Range("j" & y)
     Range(strCellaModificata).Offset(0, 19).Select
     Selection.NumberFormat = "$* #,##0.00"
     Range(strCellaModificata).Offset(0, 22) = Workbooks("dbnew.xlsx").Worksheets("db").Range("o" & y)
     Range(strCellaModificata).Offset(0, 23) = Workbooks("dbnew.xlsx").Worksheets("db2").Range("p" & y)
     Range(strCellaModificata).Offset(0, 24) = Workbooks("dbnew.xlsx").Worksheets("db2").Range("q" & y)
     Range(strCellaModificata).Offset(1, 0).Select
     ActiveWindow.ScrollColumn = 3
      
     blnTrovato = True
  End If
  
  y = y + 1
      
  Loop

  If blnTrovato = False Then
  
  intrisposta = MsgBox("Il prodotto inserito non è presente nell'archivio, " _
   & "vuoi aprire il file dbnew per aggiungerlo?", vbYesNo)
   
   If intrisposta = vbYes Then
     frmPassword.Show
     End If
   End If
 End If
End Sub

di Nicola (utente non iscritto) data: 21/01/2014 12:59:50
Ho inserito un esempio nel file PIano Promo

Nel codice master ho inserito L'art :001104

è in automatico mi ha compliato(Esploso gli articoli legati al master)
001104 JOHNSONS BAGNO IDRATANTE 750-V
001434 JOHNSONS BAGNO VELLUTANTE MIELE 750-V
005536 JOHNSONS BAGNO BE FRESH IMAGINE 750ML-V
005534 JOHNSONS BAGNO BE FRESH WAKE UP 750ML-V
005535 JOHNSONS BAGNO BE FRESH REVIVE 750ML-V
020202 JOHNSONS BAGNO ADDOLCENTE NEW 750ML-V
045912 JOHNSONS BAGNO RILASSANTE MANDO.750-V

Che casino

Esplosione codice articolo
di Nicola (utente non iscritto) data: 21/01/2014 09:54:35
Salve a tutti è complimenti per il forum.

Ho un problema e non so come poterlo arginare .
Ho creato con vba per xls una tabella dove gestisco il piano promozionale degli articoli che vendo.
Attrasverso un db in xls dove ho la scheda anagrafica dell'articolo, mi prendo il codice e in automatico mi inserisce tutti i dati relativi al prodotto e fino a qui tutto bene.
Il mio problema è che ad ogni codice è legato un codice gruppo ES.
Cod gruppo codice singolo
000090 000020
000090 000030
000090 000040

Notate che il codice singolo è legato ade un codice capo gruppo.

Vorrei attraverso codice vba inserire nella mia tabella promozionale il codice capo gruppo ossia "000090"
è in automatico mi esplodesse in verticale gli articoli singoli legati ad esso ossia "000020";"000030";"000040".
Spero di essere stato abbastanza chiaro ....
Vi ringrazio aticipatamente

Il codice vba è QUELLO CHE USO PER IL PIANO PROMOZIONALE

Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   Dim strCellaModificata As String
   Dim strColonna As String
   Dim strRiga As String
   Dim intrisposta As Integer
   Dim y As Integer
   Dim blnTrovato As Boolean
   Dim strWorkbook As String
   

   
   blnTrovato = False
   
   Const conPercorso = "C:UsersPc_InfovisionDesktopvba"
   'quando si verifica un cambiamento(change) chiedo ad excel di memorizzare in target.adress il range modificato
   'nella variabile strcellamodificata
   
   strCellaModificata = Target.Address
 
strWorkbook = ActiveWorkbook.Name

       
   'verifico se è stata modificata una sola cella per volta oppure un intervallo di celle
   
 If Range(strCellaModificata).Count > 1 Then
   Exit Sub
 End If

   'nella variabile strcolonna memorizzo il valore della proprietà colum ossia la posizione della colonna
   strColonna = Range(strCellaModificata).Column
   
   strRiga = Range(strCellaModificata).Row
'se vi è una modifica nella colonna d dalla riga 7 apro il percorso al database in sola lettura

If strColonna = 2 And strRiga >= 9 Then
   Workbooks.Open Filename:=conPercorso & "dbnew.xlsx", ReadOnly:=True
  'ora attivo con il metodo activate il modulo promo
 
    Workbooks(strWorkbook).Activate
    y = 1
    
    Do Until blnTrovato = True Or y = 43000
    If UCase(Range(strCellaModificata)) = UCase(Workbooks("dbnew.xlsx").Worksheets("db").Range("A" & y)) Then
      
     Range(strCellaModificata).Offset(0, 7) = Workbooks("dbnew.xlsx").Worksheets("db").Range("B" & y)
     Range(strCellaModificata).Offset(0, 4) = Workbooks("dbnew.xlsx").Worksheets("db").Range("d" & y)
     Range(strCellaModificata).Offset(0, 1) = Workbooks("dbnew.xlsx").Worksheets("db").Range("e" & y)
     Range(strCellaModificata).Offset(0, 5) = Workbooks("dbnew.xlsx").Worksheets("db").Range("f" & y)
     Range(strCellaModificata).Offset(0, 6) = Workbooks("dbnew.xlsx").Worksheets("db").Range("g" & y)
     Range(strCellaModificata).Offset(0, 8) = Workbooks("dbnew.xlsx").Worksheets("db").Range("h" & y)
     Range(strCellaModificata).Offset(0, 8).Select
     Selection.NumberFormat = "$* #,##0.00"
     Range(strCellaModificata).Offset(0, 13) = Workbooks("dbnew.xlsx").Worksheets("db").Range("i" & y)
     Range(strCellaModificata).Offset(0, 13).Select
     Selection.NumberFormat = "$* #,##0.00"
     Range(strCellaModificata).Offset(0, 19) = Workbooks("dbnew.xlsx").Worksheets("db").Range("j" & y)
     Range(strCellaModificata).Offset(0, 19).Select
     Selection.NumberFormat = "$* #,##0.00"
     Range(strCellaModificata).Offset(0, 22) = Workbooks("dbnew.xlsx").Worksheets("db").Range("o" & y)
     Range(strCellaModificata).Offset(0, 23) = Workbooks("dbnew.xlsx").Worksheets("db2").Range("p" & y)
     Range(strCellaModificata).Offset(0, 24) = Workbooks("dbnew.xlsx").Worksheets("db2").Range("q" & y)
     Range(strCellaModificata).Offset(1, 0).Select
     ActiveWindow.ScrollColumn = 3
      
     blnTrovato = True
  End If
  
  y = y + 1
      
  Loop

  If blnTrovato = False Then
  
  intrisposta = MsgBox("Il prodotto inserito non è presente nell'archivio, " _
   & "vuoi aprire il file dbnew per aggiungerlo?", vbYesNo)
   
   If intrisposta = vbYes Then
     frmPassword.Show
     End If
   End If
 End If
End Sub

di patel data: 21/01/2014 10:00:13
allega un file di esempio, sarà più facile aiutarti
di Grograman (utente non iscritto) data: 21/01/2014 10:02:30
Mi vengono in mente 2 soluzioni:

- Subotali

- Pivot e conseguente comando vba "Range(XY).ShowDetail = True"

Ma senza un file di esempio non saprei da dove cominciare ^_^
di Nicola (utente non iscritto) data: 21/01/2014 10:25:54
Ho inserito 2 file

il dbnew e il piano promo...

Aprenndo il db si nota subito il codice singolo e il codice capo gruppo master

Mentre aprendo il piano promo nella colonna codice attualmente digito il il singolo e in automatico mi riempie la riga con tutte le informazioni date dal db..

Ma la cosa bella sarebbe
inserire nella colonna codice il capo gruppo è in automatico mi inserisca tutte le righe singole
di Grograman (utente non iscritto) data: 21/01/2014 11:03:58
Ti ho allegato un esmepio di come si potrebbe usare il subtotale, ho prima convertito il testo in numeri per poter sfruttare la media dei valori in modo da evidenziare in grassetto il codice "mastro"
di Nicola (utente non iscritto) data: 21/01/2014 12:20:22
Ciao Grograman grazie per il tuo aiuto...

Forse mi sono spiegato male

Nel db ho gia il codice mastro....

Se ti apri l'altro file "Piano Promo" c'e una colonna con il nome codice...

Vorrei inserire in quella colonna il codice mastro è in automatico mi esplode tutti i codici appartenenti ad esso:::Ti allego un esempio
di Nicola (utente non iscritto) data: 21/01/2014 12:29:22
Ho inserito un esempio nel file PIano Promo

Nel codice master ho inserito L'art :001104

è in automatico mi ha compliato(Esploso gli articoli legati al master)
001104 JOHNSONS BAGNO IDRATANTE 750-V
001434 JOHNSONS BAGNO VELLUTANTE MIELE 750-V
005536 JOHNSONS BAGNO BE FRESH IMAGINE 750ML-V
005534 JOHNSONS BAGNO BE FRESH WAKE UP 750ML-V
005535 JOHNSONS BAGNO BE FRESH REVIVE 750ML-V
020202 JOHNSONS BAGNO ADDOLCENTE NEW 750ML-V
045912 JOHNSONS BAGNO RILASSANTE MANDO.750-V

Che casino
di gaetanopr data: 21/01/2014 19:17:26
Ciao ho modificato la tua macro, vedi se va bene, devi cambiare il percorso del file in quanto nell'allegato è indicato quello del mio desktop.
il file è "Piano promozionaleGaetano.xlsm"
PS: piccolo chiarimento, quando dichiari una variabile destinata a contenere i riferimenti di riga non dimensionarla come integer ma come Long, nel tuo file era previsto un ciclo che poteva arrivare fino a 43000 righe, superando le 32767 righe sarebbe andato in overflow.
Ciao
di Nicola (utente non iscritto) data: 22/01/2014 09:50:59
Ciao Gaetano grazie mille per la tua considerazione.....Sono appena arrivato in ufficio ......Provo immediatamente il new codice .....Ti faccio sapere immediatamente
di Nicola (utente non iscritto) data: 24/01/2014 10:33:53
Ciao Gaetano...

Saresti cosi gentile da spiegarmi passo per passo che cosa fa il codice che mi hai inserito????

Mi piace tanto programmare in vba ma sono ancora molto lontano da sapere prendere le decisioni giuste in quanto ho iniziato da poco ad appassionarmi di programmazione.

Inoltre mi daresti qualche suggerimento utile per migliorarmi ?
Compro spesso manuali .....Ma sono molto limitati in quanto mancano di esempi,,,,

Mi daresti quindi qualche consiglio per migliorarmi come autodidata ????

Grazie mille
di Nicola (utente non iscritto) data: 24/01/2014 12:25:06
Ho provato il codice modificato ...una figata .....grande

Ora mi sorge un altro piccolo problemino ...

Supponiamo di avere all'interno del Workbooks piu fogli dei lavoro ogniuno con un nome diverso ....

Non neccessariamente devo cambiare il codice per ciascuno di essi ....Ma dovrei credo utilizzare il metodo activate. per ciascun foglio che vado a selezionare????

Come potrei modificare quindi il tuo codice

Grazieeeee
di gaetanopr data: 24/01/2014 14:25:40
cit:"Supponiamo di avere all'interno del Workbooks piu fogli dei lavoro ogniuno con un nome diverso ....

Non neccessariamente devo cambiare il codice per ciascuno di essi ....Ma dovrei credo utilizzare il metodo activate. per ciascun foglio che vado a selezionare???? "
In linea generale per effettuare operazioni non è necessario selezionare o attivare i fogli, nel tuo caso la macro sfrutta l'evento change del foglio, quindi ti trovi già sul foglio interessato e oltretutto devi copiare i dati sullo stesso.
Puoi copiare la macro in tutti i fogli interessati, naturalmente devono avere la stessa struttura, oppure sfruttare l'evento change a livello di workbook "workbook_sheetchange", sul forum puoi trovare vari esempi.
Cambia questa parte, anche se si potrebbe evitare di fare riferimento al foglio.
Set Sh1 = Workbooks(strWorkbook).Sheets("Foglio1")
con
Set Sh1 = Workbooks(strWorkbook).ActiveSheet

per quanto riguarda le spiegazioni,se ricordo bene rispetto la tua macro ho modificato soltanto il loop sostituendolo con il metodo "FindNext", puoi consultare la guida in linea per avere spiegazioni con relativi esempi.

cit:"Mi daresti quindi qualche consiglio per migliorarmi come autodidata ???? "
io personalmente quando posso seguo i forum e leggo libri specifici su excel che vanno da come aprire un file excel all'uso del vba, quindi non commettere l'errore comune di comprare libri "troppo avanti" rispetto le tue conoscenze attuali
ciao

di gaetanopr data: 24/01/2014 14:43:56
Ho aggiunto una riga per chiudere il file "dbnew.xlsx" una volta terminata la copia
ecco la macro integrale

Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   Dim strCellaModificata As String
   Dim strColonna As String
   Dim strRiga As String
   Dim intrisposta As Integer
   Dim y As Long, Rng As Range, firstAddress As String
   Dim blnTrovato As Boolean
   Dim strWorkbook As String
   Dim Riga As Long, LastRow As Long
   Dim ID As String, Sh1 As Worksheet
   
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B9:B" & Cells(Rows.Count, "B").End(xlUp).Row)) Is Nothing Then
   blnTrovato = False
   Const conPercorso = "C:Documents and SettingsAdministratorDesktop"
  
   strWorkbook = ActiveWorkbook.Name

   Application.ScreenUpdating = False
   Application.EnableEvents = False
   
   Workbooks.Open Filename:=conPercorso & "dbnew.xlsx", ReadOnly:=True
   LastRow = Workbooks("dbnew.xlsx").Worksheets("db").Cells(Rows.Count, "B").End(xlUp).Row

    Riga = Cells(Rows.Count, "D").End(xlUp).Row + 1
    If Riga < 9 Then Riga = 9
    Workbooks(strWorkbook).Activate
    Set Sh1 = Workbooks(strWorkbook).ActiveSheet
    

 ID = Target.Value
 With Workbooks("dbnew.xlsx").Worksheets("db").Range("B2:B" & LastRow)
  Set Rng = .Find(What:=ID, LookAt:=xlWhole, LookIn:=xlValues)
  If Not Rng Is Nothing Then
    firstAddress = Rng.Address
    Do
      Sh1.Range("D" & Riga).Value = Rng.Offset(0, -1).Text
      Sh1.Range("I" & Riga).Value = Rng.Offset(0, 1).Text
      Riga = Riga + 1
      Set Rng = .FindNext(Rng)
      blnTrovato = True
    Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
  End If
 End With
 Workbooks("dbnew.xlsx").Close
  If blnTrovato = False Then
  
  intrisposta = MsgBox("Il prodotto inserito non è presente nell'archivio, " _
   & "vuoi aprire il file dbnew per aggiungerlo?", vbYesNo)
   
   If intrisposta = vbYes Then
     frmPassword.Show
    End If
   End If
 End If
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Set Sh1 = Nothing
 Set Rng = Nothing
End Sub

di Nicola (utente non iscritto) data: 24/01/2014 15:31:28
Grazie gaetano....Gentilissimo veramente .....

Ora provo la modifica e ti faccio sapere ...

Grazie mille
di Nicola (utente non iscritto) data: 29/01/2014 10:59:58
Ciao Gaetano.....sto lavorando sul codice e lo sto aplicando sul mio progetto....

Se io volessi inserire 2 opzioni ossia :
Nella colonna b Il codice capo master con la relatica esplosione dei codici singoli nella colonna D
E nella colonna D i codici singoli inseriti a mano con la relative condizioni anagrafiche in automatico (descrizione ecc )
Dovrei creare un altro evento """""Sub Worksheet_Change(ByVal Target As Excel.Range)"""" modificando i vari percorsi?????

Grazieeeeeeee in anticipo

di Nicola (utente non iscritto) data: 29/01/2014 12:57:55
Inserisco il codice che mi hai modificato ed io ho inserito un operatore logico "OR"

Purtroppo non riesco a farlo partire :::

Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   Dim strRiga As String
   Dim intrisposta As Integer
   Dim y As Long, Rng As Range, firstAddress As String
   Dim blnTrovato As Boolean
   Dim strWorkbook As String
   Dim Riga As Long, LastRow As Long
   Dim ID As String, Sh1 As Worksheet
 
    
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B9:B" & Cells(Rows.Count, "B").End(xlUp).Row)) Or _
    Not Intersect(Target, Range("C9:C" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then
    
   blnTrovato = False
   Const conPercorso = "C:UsersPc_InfovisionDesktop"
  
   strWorkbook = ActiveWorkbook.Name

   Application.ScreenUpdating = False
   Application.EnableEvents = False
   
   Workbooks.Open Filename:=conPercorso & "dbnew.xlsx", ReadOnly:=True
   LastRow = Workbooks("dbnew.xlsx").Worksheets("db").Cells(Rows.Count, "B" Or "A").End(xlUp).Row

    Riga = Cells(Rows.Count, "C" Or "I").End(xlUp).Row + 1
    If Riga < 9 Then Riga = 9
    Workbooks(strWorkbook).Activate
    Set Sh1 = Workbooks(strWorkbook).ActiveSheet
    

 ID = Target.Value
 With Workbooks("dbnew.xlsx").Worksheets("db").Range("B2:B" Or "A2:A" & LastRow)
  Set Rng = .Find(What:=ID, LookAt:=xlWhole, LookIn:=xlValues)
  If Not Rng Is Nothing Then
    firstAddress = Rng.Address
    Do
      Sh1.Range("C" & Riga).Value = Rng.Offset(0, -1).Text
      Sh1.Range("I" & Riga).Value = Rng.Offset(0, 1).Text
      Sh1.Range("G" & Riga).Value = Rng.Offset(0, 4).Text
      Sh1.Range("H" & Riga).Value = Rng.Offset(0, 5).Text
      Sh1.Range("F" & Riga).Value = Rng.Offset(0, 3).Text
      Sh1.Range("J" & Riga).Value = Rng.Offset(0, 6).Text
      Sh1.Range("O" & Riga).Value = Rng.Offset(0, 7).Text
      Sh1.Range("U" & Riga).Value = Rng.Offset(0, 8).Text
      Sh1.Range("X" & Riga).Value = Rng.Offset(0, 13).Text
      
      Riga = Riga + 1
      Set Rng = .FindNext(Rng)
      blnTrovato = True
    Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
  End If
 End With
 Workbooks("dbnew.xlsx").Close
  If blnTrovato = False Then
  
  intrisposta = MsgBox("Il prodotto inserito non è presente nell'archivio, " _
   & "vuoi aprire il file dbnew per aggiungerlo?", vbYesNo)
   
   If intrisposta = vbYes Then
     frmPassword.Show
    End If
   End If
 End If
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Set Sh1 = Nothing
 Set Rng = Nothing

End Sub

di Nicola (utente non iscritto) data: 29/01/2014 14:13:45
Ho inserito il db + il volantino da compilare

Grazieeee

di gaetanopr (utente non iscritto) data: 29/01/2014 15:05:11
Ciao non ho scaricato l'ultimo tuo file, prova intanto questa

Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   Dim strCellaModificata As String
   Dim strColonna As String
   Dim strRiga As String
   Dim intrisposta As Integer
   Dim y As Long, Rng As Range, firstAddress As String
   Dim blnTrovato As Boolean
   Dim strWorkbook As String
   Dim Riga As Long, LastRow As Long, Col As Long
   Dim ID As String, Sh1 As Worksheet, RangeMaster As Range, RangeSingolo As Range
   Set RangeMaster = Range("B9:B" & Cells(Rows.Count, "B").End(xlUp).Row)
   Set RangeSingolo = Range("D9:D" & Cells(Rows.Count, "D").End(xlUp).Row)
   
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, RangeMaster) Is Nothing Or Not Intersect(Target, RangeSingolo) Is Nothing Then
       Col = Target.Column
       If Col = 2 Then ColS = "B": If Col = 4 Then ColS = "A"
    Const conPercorso = "C:Documents and SettingsAdministratorDesktop"
   
   strWorkbook = ActiveWorkbook.Name

   Application.ScreenUpdating = False
   Application.EnableEvents = False
   
   Workbooks.Open Filename:=conPercorso & "dbnew.xlsx", ReadOnly:=True
   LastRow = Workbooks("dbnew.xlsx").Worksheets("db").Cells(Rows.Count, Col).End(xlUp).Row

    Riga = Cells(Rows.Count, "D").End(xlUp).Row + 1
    If Riga < 9 Then Riga = 9
    Workbooks(strWorkbook).Activate
    Set Sh1 = Workbooks(strWorkbook).ActiveSheet

 ID = Target.Value
 With Workbooks("dbnew.xlsx").Worksheets("db").Range(ColS & "2:" & ColS & LastRow)
  Set Rng = .Find(What:=ID, LookAt:=xlWhole, LookIn:=xlValues)
  If Not Rng Is Nothing Then
    If ColS = "B" Then
    firstAddress = Rng.Address
    Do
      Sh1.Range("D" & Riga).Value = Rng.Offset(0, -1)
      Sh1.Range("I" & Riga).Value = Rng.Offset(0, 1)
      Riga = Riga + 1
      Set Rng = .FindNext(Rng)
      blnTrovato = True
    Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
    Else
      Sh1.Range("I" & Riga - 1).Value = Rng.Offset(0, 2)
      blnTrovato = True
  End If
 End If
End With
Workbooks("dbnew.xlsx").Close
  If blnTrovato = False Then
  
  intrisposta = MsgBox("Il prodotto inserito non è presente nell'archivio, " _
   & "vuoi aprire il file dbnew per aggiungerlo?", vbYesNo)
   
   If intrisposta = vbYes Then
     frmPassword.Show
    End If
   End If
 End If
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Set Sh1 = Nothing
 Set Rng = Nothing
 Set RangeMaster = Nothing
 Set RangeSingolo = Nothing
End Sub

di gaetanopr (utente non iscritto) data: 29/01/2014 15:25:44
Togli i 2 "blnTrovato = True" e ne metti uno dopo "If Not Rng Is Nothing Then" oltretutto non ha senso metterlo all'interno del loop
di Nicola (utente non iscritto) data: 29/01/2014 15:28:04
Grazie gaetano ...sto provando il codice

Mi dice la variabile cols non è definita......che fare
di gaetanopr (utente non iscritto) data: 29/01/2014 15:40:32
Dim Cols As String, questo almeno lo devi saper fare!!!!
di Nicola (utente non iscritto) data: 29/01/2014 15:50:06
Ti ho inserito l'errore nel foglio in allegato di word

Chen mal di testa
di Nicola (utente non iscritto) data: 29/01/2014 15:54:10
Tranquillo gia fatto.....non ho notato i 2 col uno con la s e l'altro senza....scusami

Lo gia modificato

ma ti ho appena girato un file error run time 13.....
di Nicola (utente non iscritto) data: 29/01/2014 16:12:05
Sei un grande veramente .......

Sta funzionando ...bellisssssimo

ora inserisco nel codice tutte le altre righe per completare piano del volantino....è ovviamente ti farò sapere ....

Saresti cosi gentile da spiegarmi i vari passaggi????C'e tanto da imparare con uno come te .....grazie mille...

Appena finisco il proggetto ti spedirò un qualcosa di buono di Sardegna....Se ti fa piacere....Ti sono debitore e mi fa piacere a me
di Nicola (utente non iscritto) data: 03/02/2014 16:16:53
Grazie gaetano ....ho completato il mio progetto e devo dire che funziona benissimo ......Sto seguendo il tuo consiglio e infatti controllo spesso il forum per migliorare la mia conoscenza con vba ...

Mi farò sentire presto per nuovi progetti ...

Grazie mille

Vuoi Approfondire?