Ta boucle for n'a pas de fin :

For K = 2 To Lsce 
...
Next K

If Vcherche = "1" Then 
   Début = 2 
   If Vcherche = "2" Then 
      Début = 100 
      If Vcherche = "3" Then 
         Début = 1000 
         If Vcherche = "4" Then 
            Début = 2000 
         End If 
      End If 
   End If 
End If 

If Vcherche = "1" Then 
   Début = 2 
End If 
If Vcherche = "2" Then   
   Début = 100 
End If 
If Vcherche = "3" Then 
   Début = 1000 
End If 
If Vcherche = "4" Then 
   Début = 2000 
End If 

Bonjour,

Probléme, la valeur de j reste à 0 ... où est initialisé ligne dans For j = 2 to ligne ?

;o) «Ce que l'on conçoit bien s'énonce clairement, Et les mots p­our le dire arrivent aisément.» 
Nicolas Boileau

Bonjour tous,
Peut-être avec cette tite macro...

Sub VB12()
Dim K As Long, J As Long
Dim FL1 As Worksheet
Dim FL2 As Worksheet
    Set FL1 = Workbooks("C1.xls").Sheets("Feuil1")
    Set FL2 = Workbooks("C2.xls").Sheets("Feuil2")
    
    For K = 2 To FL1.Range("E65536").End(xlUp).Row
        For J = 2 To FL2.Range("A65536").End(xlUp).Row
            If FL1.Cells(K, 5) = FL2.Cells(J, 1) Then
                FL2.Cells(J, 2).Copy FL1.Cells(K, 7)
                Exit For
            End If
        Next J
    Next K
End Sub

Quand tu fait des opérations sur 2 classeurs, ça prend toujours plus de temps ça dépend aussi du nombre de lignes à traiter, dans ton cas il faut tester 16000 x 300 = 4.800.000 lignes !!
Tu peu déjà un peu accélérer en intercalant les lignes ...

    Set FL2 = Workbooks("C2.xls").Sheets("Feuil2")

    Application.EnableEvents = False 'annule provisoirement les macro qui pourraient-êtres dans les événements de feuilles.
    Application.ScreenUpdating = False ' annule provisoirement la mise à jour de l'affichage.


    For K = 2 To FL1.Range("E65536").End(xlUp).Row

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

fl1.range("E65536").end(xlUp).row
Exact, sauf que c'est une fonction Excel VBA et le résultat est pratiquement immédiat.
Pour ta 2ém question, j'ai pas compris. L'expérience instruit plus sûrement que le conseil. (André Gide)  
Si tu te cogne à un pot et que ça sonne creux, c'est pas forcement le pot qui est vide. ;-)(Confucius)

Dim FP as string
FP= "C:\Répertoir\SousRépertoir\NomFichier.xls" 'Le chemin complet + nom + extention
Workbooks.Open (FP)
et pour sauver c'est
Workbooks(FP).Save 'mais là, le nom et l'extention suffisent.
A+ L'expérience instruit plus sûrement que le conseil. (André Gide)  
Si tu te cogne à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)

Essaie cette macro, elle devrait être sensiblement plus rapide.

Sub VB12()
Dim K As Long, J As Long, Plage() As String
Dim Cherch As String, Ligne As Long, Lig As Long
Dim FL1 As Worksheet
Dim FL2 As Worksheet

    'annule provisoirement les macro qui pourraient-êtres dans les événements de feuilles.
    Application.EnableEvents = False
    'annule provisoirement la mise à jour de l'affichage.
    Application.ScreenUpdating = False
    
    Set FL1 = Workbooks("C1.xls").Sheets("Feuil1") 'Destination
    Set FL2 = Workbooks("C2.xls").Sheets("Feuil2") 'origine

    Lig = FL2.Range("A65536").End(xlUp).Row
    Ligne = FL1.Range("E65536").End(xlUp).Row
    
    ReDim Plage(2 To Lig)
    For J = 2 To Lig: Plage(J) = FL2.Cells(J, 1): Next
    
    For K = 2 To Ligne
        Cherch = FL1.Cells(K, 5)
        For J = 2 To Lig
            If Cherch = Plage(J) Then
                FL2.Cells(J, 2).Copy FL1.Cells(K, 7)
                Exit For
            End If
        Next J
        DoEvents
    Next K
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub