Copie entre deux classeurs avec condition

Bonjour à tous,

Je souhaite copier/coller des données d'un classeur b vers un classeur a à condition que le nom dans la colonne F du classeur b m'intéresse.

Cette même colonne F est trié par ordre alphabétique.

La fonction de recherche fonctionne bien cependant, le programme bug avec la méthode .copy, ou alors l'objet Range en ligne 43. "Propriété ou méthode non gérée par cette objet"

Ça fait quelques jours que j'écume les forums mais je ne comprend toujours pas.

Sub extract_sta()

Dim wa As Workbook
Dim wb As Workbook
Dim fa As Worksheet
Dim fb As Worksheet
Dim otp As String
Dim index_a As Variant
Dim index_b As Variant
Dim k As Variant

Set wa = ActiveWorkbook
Set fa = wa.Sheets("Extract Hres")
otp = wa.Sheets("Bilan").Range("C14").Value
index_a = 258

Set wb = Workbooks.Open(Filename:="C:\Users\hugo8\OneDrive\Bureau\OneDrive_1_26-10-2019\EXTRACT_PROJET-09.19 test.xlsm")
Set fb = wb.Sheets("STAT")
index_b = 3

wb.Activate
fb.Activate

While Range("F" & index_b).Value <> otp

    index_b = index_b + 1

Wend

MsgBox index_b

k = index_b

While fb.Range("F" & k).Value = otp

    k = k + 1

Wend

MsgBox k

wb.fb.Range("B" & index_b & ":" & "N" & k).Copy
wa.fa.Range("B" & index_a & ":" & "N" & index_a + k).Paste

wa.Activate
fa.Activate

wb.Close False

End Sub

De plus, savez vous comment appeler plusieurs module à partir d'un autre module ?

Merci à tous !

Hugo

Bonsoir,

C'est dommage qu'on arrive pas tester et déboguer sans fichier.

Raja a écrit :

Bonsoir,

C'est dommage qu'on arrive pas tester et déboguer sans fichier.

Et voilà

Up svp

Re,

Code à tester :

Sub extract_sta()
    Dim wa As Workbook
    Dim wb As Workbook
    Dim fa As Worksheet
    Dim fb As Worksheet
    Dim otp As String
    Dim index_a As Variant
    Dim index_b As Variant
    Dim k As Variant
    Set wa = ActiveWorkbook
    Set fa = wa.Sheets("Extract Hres")
    otp = wa.Sheets("Bilan").Range("C14").Value
    index_a = 1
    Set wb = Workbooks.Open(Filename:="C:\Users\hugo8\OneDrive\Bureau\Workbook B.xlsm")
    Set fb = wb.Sheets("STAT")
    index_b = 3
    wb.Activate
    fb.Activate
    While Range("F" & index_b).Value <> otp
        index_b = index_b + 1
    Wend
    MsgBox index_b
    k = index_b
    While fb.Range("F" & k).Value = otp
        k = k + 1
    Wend
    MsgBox k
    fb.Range("B" & index_b & ":" & "N" & k - 1).Copy
    wa.Activate
    fa.Activate
    Range("B" & index_a).PasteSpecial
    Application.CutCopyMode = xlCopy
    wb.Close False
End Sub

Merci beaucoup ça fonctionne