VBA : optimisation macro

Bonjour à tous !

Je suis une newbie en VBA et il y a toujours des bugs que je n'arrive pas à résoudre et mes macros ne sont pas du tout optimisées (elles mettent bcp trop de temps à tourner...) :-s

Voici ce que je veux faire :
J'ai un fichier avec des onglets dans lesquels se trouvent dans chaque colonne A des données (numéro d'identification de protéines) - sachant que dans une cellule, il peut y avoir jusqu'à 50 numéros d'identification différents séparés par un point-virgule. Chaque onglet correspond à une base de données.
-> je veux toutes les regrouper dans mon onglet "Database" (=Worksheets(1)) où chaque "Protein ID" ne doit apparaître qu'une fois, dans la colonne, toutes les unes à la suite des autres. (Sachant que les bases de données sont assez conséquentes).

J'ai donc écrit une macro qui convertit les données sur chaque onglet pour les séparer dans des cases différentes. Ensuite, je recopie toutes les données de mon premier onglet (=première BDD) dans l'onglet "Database". Enfin, je prends les onglets suivants et recherche pour chaque cellule non vide si la donnée existe déjà dans Database, et si non, je la recopie à la suite (ce qui est très long).

Je sais qu'il faut éviter de faire des .select mais la macro ne rapatrie pas mes données quand je ne l'écris pas... Et pour la seconde partie de la macro (à partir du Case Else), les données ne sont pas rapatriées, mais je ne comprends pas pourquoi !

Voici mon code, si quelqu'un a une idée de comment je peux optimiser tout ça et pourquoi la fin de la macro ne fonctionne pas, je vous en serai vraiment reconnaissante !! :-D

Sub generate_database()

Dim nb As Integer
Dim i As Integer, j As Integer, k As Integer
Dim li As Integer
Dim LastCell As Range
Dim myvar
Dim Chart As Range

nb = ActiveWorkbook.Worksheets.Count

For i = 2 To nb
Worksheets(i).Activate
Range("A2").Select
Range(Selection, Range("A66530").End(xlUp)).Select
Selection.TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
Next i

Set LastCell = Worksheets("Database").Range("A3")
Set Chart = Worksheets("Database").Columns("A:A")

For i = 2 To nb
Worksheets(i).Select
Select Case i

Case 2
Range("A2", Range("A66530").End(xlUp)).Select
li = Selection.Rows.Count
For k = 2 To li + 1
j = 3
While Not IsEmpty(Cells(k, j))
myvar = Cells(k, j).Value
Worksheets("Database").Select
LastCell.Select
LastCell.Value = myvar
Set LastCell = LastCell.Offset(1, 0)
Worksheets(i).Select
j = j + 1
Wend
Next k

Case Else
Range("A2", Range("A66530").End(xlUp)).Select
li = Selection.Rows.Count
For k = 2 To li + 1
j = 3
While Not IsEmpty(Cells(k, j))
On Error Resume Next
If Application.WorksheetFunction.IsError(Application.WorksheetFunction.VLookup(" & Cells(k, j) & ", Chart, 1, False)) = True Then
Worksheets("Database").Select
LastCell.Select
LastCell.Value = myvar
Set LastCell = LastCell.Offset(1, 0)
Worksheets(i).Select
j = j + 1
Else: j = j + 1
End If
Wend
Next k

End Select

Next i

Set LastCell = Nothing
Set Chart = Nothing

End Sub

Merci par avance pour votre précieuse aide !!!!!