Erreur Macro copier/coller d'un autre classeur et fonction recherchev

[AntoineM]

Bonjour le forum,

Petit problème de formule et macro.

Dugenou a résolu un de mes soucis ce matin https://www.excel-downloads.com/threads/erreur-fonction-recherchev.231370/

Pour résumer :
J'ai créer une macro qui me permet de copier/coller des données depuis un classeur ouvert vers un autre classeur.
Je transforme ces données en utilisant des sous totaux, puis en ne copiant que les sous totaux.

La macro fonctionne apparemment bien. Cependant lorsque je fais une recherchev, les valeurs copiées ne ressortent pas.

Voici la macro :

Sub ExtractionISS()

Application.ScreenUpdating = False

'Dénomination des classeurs
Dim Wbk As Workbook
Dim ClasseurSource As Workbook
Dim ClasseurDest As Workbook

Set ClasseurSource = ThisWorkbook

For Each Wbk In Application.Workbooks
    If Left(Wbk.Name, 8) = "ISS_File" Then
        Set ClasseurDest = Wbk
               Exit For
    End If
Next Wbk

'message d'erreur si fichier ISS non-activé
On Error Resume Next
 ClasseurDest.Activate
 If Err.Number <> 0 Then
  MsgBox "Avez-vous bien ouvert le fichier Excel de l'extraction ISS ?"

 Else

'Copie des données ISS dans feuille temporaire
ClasseurSource.Activate
Sheets.Add.Name = "ISStemp"
ClasseurSource.Sheets("ISStemp").Range("A1:I10000") = _
ClasseurDest.Sheets("Comparison details").Range("A1:I10000").Value

'Définition des sous-totaux
    Sheets("ISStemp").Range("A1").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
    Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    
'Copie des lignes de sous total
Sheets("ISStemp").Range("A1:AZ1000").SpecialCells(xlVisible).Copy _
Destination:=Sheets("ISS").Range("A1:AZ1000")

'supression des colonnes inutiles et attribution du nom "quantité"
Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Range("B1").Value = "Quantité"
    
Sheets("ISS").Activate
Rows("1").Select
Selection.Delete Shift:=xlUp

'supression des colonnes inutiles et attribution des noms
Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Range("A1").Value = "Référence"
    Range("B1").Value = "Quantité"

'supression de la ligne "total général"
Dim I As Integer
For I = [A65000].End(xlUp).Row To 1 Step -1
If Not Cells(I, 1).Find("Total général") Is Nothing Then Rows(I).Delete
Next I

'efface les 6 premiers caracteres ("Total ") dans chaque cellule
Dim Nc, Cel As Range
    For Each Cel In Range("A2", [A65000].End(xlUp))
              Nc = Len(Cel)
        Cel.Value = Right(Cel, Nc - 6)
    Next Cel
    
Sheets("ISS").Cells.ClearFormats
    
'Supression de la feuille ISS et activation de la feuille principale
Application.DisplayAlerts = False
Sheets("ISStemp").Delete
Application.DisplayAlerts = True
ClasseurSource.Sheets("Consolidation").Activate
    
Application.ScreenUpdating = True

 End If
 On Error GoTo 0

End Sub

En copie vous trouverez les fichier que j'avais joint lors de mon sujet sur la fonction recherchev