macro cerca e inserisci

[zorea]

Ciao
scopiazzando qua e là, ho buttato giù la macro che segue.
Sostanzialmente:
- verifico se il valore che inserisco nella cella C4 del foglio1 (partita iva) è presente nella tabella/"db" del foglio2 (stessa cartella):
se vero, mi rende alcune informazioni presenti in tabella/"db" (ne ho inserito solo una parte); se falso, mi restituisce una MsgBox, che mi suggerisce l'inserimento dei dati (per il popolamneto della tabella/"db" stessa, che effettuerò con la sub Copia)

2 domande:
la prima: vorrei, se possibile, inserire direttamente la "sub copia" dopo aver inserito tutti i dati, senza passare per il "click" sul pulsante ad essa associato. (Nessun campo deve rimanere vuoto, nel caso indicato b6, b8, c6, c8).
la seconda: la prima colonna della tabella/"db" è un contatore, che ora ho impostato con la funzione SE (che controlla la presenza della piva); vorrei però inserirlo sempre nel codice,ma o mi va in errore, o mi parte da 0. (esercizio 1 della prima ora di un qualsiasi corso vba, immagino... e io mi perdo!!! )

Sperando di essere stata sufficientemente chiara, attendo un vostro aiuto.

Grazie,
zorea
ps: nella sub copia la riga di codice Set originedati= Sheets(1).Range("B2:F2") è perchè "qui dentro" ho messo i dati che ho inserito ex-novo, per "ordinarl"i rispetto alla tabella/"db"

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C4")) Is Nothing Then
Exit Sub

Else

Dim CL As Object
X = [C4].Value
Set originedati= Sheets(2).Range("B2:B200")
For Each CL In originedati
If CL.Value = X Then
[B6] = CL.Offset(0, 1).Value 'nome azienda
[B8] = CL.Offset(0, 2).Value 'telefono
[C6] = CL.Offset(0, 3).Value 'referente
[C8] = CL.Offset(0, 4).Value 'e-mail referente
Exit Sub
End If
Next
MsgBox "P.IVA non presente. Verificare o inserire i campi evidenziati in giallo."
Range("B6,B8,C6,C8").ClearContents
End If
End Sub


Sub Copia()
Application.ScreenUpdating = False
Set originedati= Sheets(1).Range("B2:F2")
Sheets(2).Activate
Dim iRow As Integer
iRow = 1
With Worksheets("Foglio2")
While .Cells(iRow, 2).Value <> ""
iRow = (iRow + 1)
Wend
.Cells(iRow, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End With

Sheets(1).Activate
Application.CutCopyMode = False
Range("B6,B8,C4,C6,C8").ClearContents
End Sub


[Anthony47]

Io la prima parte della macro la eliminerei, e la sostituirei con la formula Cerca.Vert nel foglio; poi nella Worksheet_Change farei un test se B6 e' in errore (tramite If IsError(Range("B6").Value) Then etc etc)

La sub Copia vedo che fa un PasteSpecial, ma di cosa, visto che manca una Copy?
Ma siccome non e' necessario fare PasteSpecial (basta Copy & Paste, visto che sono dati digitati), puoi usare direttamente

Codice: Seleziona tutto

Sheets(1).Range("B2:F2").Copy Destination:=Sheets(2).Range("B" & Rows.Count).End(Xlup).Offset(1,0)


Questa istruzione sostituisce tutto eccetto Sub Copia() / Range("B6,B8,C4,C6,C8").ClearContents / End Sub. Non ho capito perche' non hai inserito anche il Clear di B2:F2 e magari un msgbox che informa che i dati sono stati accodati all' anagrafica.

Per quanto riguarda la col A di Foglio(2) non ho capito il discorso; forse e' un controllo che la partita Iva non venga inserita due volte? In questo caso potresti mettere una convalida su Foglio(1), in B2 (credo) del tipo "Personalizzato" e la formula =CONTA.SE(Foglio2!D:D;B2)=0
(ho immaginato che Foglio(2) si chiami Foglio2).
In questo modo non potrai inserire in B2 una P.Iva che esiste gia' in elenco.

Per quanto riguarda far partire Copia a compilazione completata, devi ampliare la testata della Worksheet_Change, per controllare piu' eventi. Qualcosa come:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address="$C$4" Then Call LaPrimaMacro
If Not Intersect(Target, Range("B2:F2")) Is Nothing Then Call Copia
Exit Sub


In testa a Copia inserirai il controllo che nessuna cella sia vuota, ad esempio con

Codice: Seleziona tutto

If Application.WorksheetFunction.CountBlank(Range("B2:F2")) > 0 Then Exit Sub


In questo caso e' obbligatorio il Clear di B2:F2 di Foglio(1).

Infine un commento: Set e With sono statements che aiutano l' esperto a migliorare la forma del proprio codice (non la sostanza); fintanto che non sei a un livello "medio" ti consiglio di trascurarli ricorrendo all' esplicitazione della voce nel codice; ad esempio, senza With:
While Worksheets("Foglio2").Cells(iRow, 2).Value <> ""

Ciao

[zorea]

Grazie!
Tutto chiaro e funzionante come sempre.

(Per pulire il codice dai miei commenti, mi sono persa la riga che avevo copiato, il paste special era perchè copiavo una formula, e anche la questione del Set e With ... non cercavo finezze ma solo un modo che a me sembrava semplice... comunque lo scrivo solo per farti sapere che ho letto e accolto ogni suggerimento... Grazie anche per la pazienza!)

zorea