Recopier des valeurs du classeur1 dans classeur2

Bonjour =E0 tous,

J=92aimerais recopier les valeurs Bx:Fx du classeur1 dans la colonne du moi=
s pass=E9 du classeur2.

Pour le moment, j=92ai une erreur pour ouvrir le classeur2 (LHCF.xls)

Le r=E9sultat voulu est dans feuil2 du classeur2.

'-----------------------------------------------------------------------
Sub Extract()
Dim WB1 As Workbook, WB2 As Workbook
Dim fMonth As Range, mPlg As Range, mF$
Dim obnPlg As Range, fnObj As Range, obPlg As Range, fObj As Range
Dim tb() As Variant, i%, Chn$

Set WB1 =3D Workbooks("TQ (1).xls")
Set WB2 =3D Workbooks.Open("LHCF.xls")

'-- Mois pass=E9
mF =3D Format(DateAdd("m", -1, Date), "mmm")

With WB1.Sheets("feuil1")
'-- Tableaux contenant les noms (Col H) et leurs =E9quivalences en =
objet (Col I)
tb =3D .Range("H2:I" & [H65000].End(xlUp).Row).Value
'-- Plage des objets dans classeur1
Set obPlg =3D .Range(.Cells(2, 1), .Cells(.Cells.Rows.Count, 1).End=
(xlUp))
End With
With WB2.Sheets("feuil1")
'-- Plage des noms des objets dans classeur2
Set obnPlg =3D .Range(.Cells(9, 1), .Cells(.Cells.Rows.Count, 1).En=
d(xlUp) _
.Offset(1, 0)) ' Pour faire en=
trer la derniere cellule fusionn=E9e
'-- Plage des mois dans classeur2
Set mPlg =3D .Range(.Cells(7, 1), .Cells(7, 256).End(xlToLeft))
End With

'-- Recherche du mois pass=E9
Set fMonth =3D mPlg.Find(mF)

For i =3D LBound(tb) To UBound(tb)
If Len(tb(i, 1)) > 0 Then
Set fnObj =3D obnPlg.Find(tb(i, 1), LookIn:=3DxlValues, LookAt:=
=3DxlPart)
If Not fnObj Is Nothing Then

Set fObj =3D obPlg.Find(tb(i, 2), LookIn:=3DxlValues, LookA=
t:=3DxlPart)
If Not fObj Is Nothing Then
'-- Si l'objet trouv=E9 se termine par un D
'-- On commence l'=E9criture juste =E0 la ligne de fnOb=
j dans classeur2
Chn =3D WB1.Sheets("feuil1").Range("A" & fObj.Row)

If Mid(Chn, Len(Chn), 1) =3D "D" Then
WB2.Sheets("feuil1").Cells(fnObj.Row, fMonth.Column=
).Resize(4, 1).Value =3D Application.Transpose(WB1.Sheets("feuil1").Range(C=
ells(fObj.Row, 2), Cells(fObj.Row, 7)).Value)

'-- Si l'objet trouv=E9 se termine par un A
'-- On commence l'=E9criture =E0 la ligne de fnObj + 8 =
lignes en bas dans classeur2
ElseIf Mid(Chn, Len(Chn), 1) =3D "A" Then
WB2.Sheets("feuil1").Cells(fnObj.Row + 8, fMonth.Co=
lumn).Resize(4, 1).Value =3D Application.Transpose(WB1.Sheets("feuil1").Ran=
ge(Cells(fObj.Row, 2), Cells(fObj.Row, 7)).Value)
End If
End If
End If
End If
Next i
Set WB1 =3D Nothing: Set WB2 =3D Nothing: Set mPlg =3D Nothing
Set obnPlg =3D Nothing: Set fnObj =3D Nothing: Set obPlg =3D Nothing: S=
et fObj =3D Nothing
End Sub
'-------------------------------------------------------------

[url]http://cjoint.com/?BFkx5djmCqV[/url]

Merci d'avance.