Ho dovuto sciupare 3 minuti del mio tempo perche' la seconda tabella e' illegibile, quindi ho dovuto immaginare cosa contenesse la colonna A; mentre sarebbe bastato un doppioclick prima di salvare l' immagine...
Prova questa macro:
- Codice: Seleziona tutto
Sub xdp8()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=100999
Dim Dest As String, I As Long, myMatch
'
Dest = "Foglio2" '<<< Il foglio dove si creera' la tabella
'
Sheets(Dest).Cells.ClearContents '*** VEDI TESTO!!!
For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Application.WorksheetFunction.CountIf(Sheets(Dest).Range("A:A"), Cells(I, 1).Value) = 0 Then
Sheets(Dest).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(I, 1)
Sheets(Dest).Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Cells(I, 2)
Else
myMatch = Application.Match(Cells(I, 1).Value, Sheets(Dest).Range("A:A"), 0)
If IsError(myMatch) Then
MsgBox ("Errore impossibile ma vero; procedura abortita")
Exit Sub
Else
Sheets(Dest).Cells(myMatch, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(I, 2).Value
End If
End If
Next I
End Sub
Si ipotiza che la tabella di origine sia in colonna A e B; l' elenco riepilogativo viene creato nel foglio indicato nell' istruzione marcata <<<, che personalizzerai come da tue preferenze. Il foglio deve gia' esistere, e SARA' AZZERATO SENZA NESSUN PREAVVISO all' avvio della macro; se questo non ti soddisfa, allora elimina l' istruzione marcata ***, e i nuovi dati saranno accodati a quanto gia' presente nel foglio di destinazione (il calcolo delle righe occupate e' pero' fatto esaminando la sola colonna A).
Ciao