Probleme de transfert donnees entre 2 classeur

sokour

XLDnaute Occasionnel
Bonjour,

Je rencontre un problème concernant une étape de mon projet :

A partir du fichier Base.xls il y a un tableau qui regroupe plusieurs devises, je dois convertir ce tableau en dollar grâce au 2em fichier Taux.xls.

Je voudrais que dans la colonne D :E du fichier Taux reprenne les données du tableau du fichier Base.xls.

Le problème est que je ne peux pas faire un simple copier coller car les devises doivent correspondre au taux de conversion concerné (fichier Taux.xls)

Pouvez-vous m’aider è résoudre ce problème et je vous joins mes 2 fichiers.

Merci
 

Fichiers joints

sokour

XLDnaute Occasionnel
Re : Probleme de transfert donnees entre 2 classeur

Il faut creer une macro qui recherche en fonction de la devise?
 

stockholm09

XLDnaute Nouveau
Re : Probleme de transfert donnees entre 2 classeur

Bonjour
Je te propose un somme si => formule a mettre dans la cellule E3
=SOMME.SI('[Base(1).xls]StatD'!$I$3:$I$18;A3;'[Base(1).xls]StatD'!$J$3:$J$18)

et à recopier dans les cellules suivantes en faisant evoluer le A3 et A4 puis A5 etc....

Esperant avoir repondu a ta question
Bonne soirée
 

job75

XLDnaute Barbatruc
Re : Probleme de transfert donnees entre 2 classeur

Bonsoir,

Exécuter cette macro, à placer dans un Module du fichier Taux :

Code:
Sub Transfert()
Dim plage As Range, F As Worksheet, cel As Range, lig As Variant
[COLOR="Red"]Application.ScreenUpdating = False[/COLOR]
Set plage = Sheets("Sheet1").Range("E3:E24")
plage.ClearContents
Set F = Workbooks("Base.xls").Sheets("StatD")
For Each cel In F.Range("I3", F.Range("I65536").Offset(-1))
  lig = Application.Match(cel, plage.Offset(, -4), 0)
  If IsNumeric(lig) Then plage(lig) = cel.Offset(, 1)
Next
End Sub
Edit : ajouté le code en rouge pour accélérer

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Probleme de transfert donnees entre 2 classeur

Re,

Autant pour moi, j'avais oublié End(xlUp) :rolleyes:

Code:
Sub Transfert()
Dim plage As Range, F As Worksheet, cel As Range, lig As Variant
Application.ScreenUpdating = False
Set plage = Sheets("Sheet1").Range("E3:E24")
plage.ClearContents
Set F = Workbooks("Base.xls").Sheets("StatD")
For Each cel In F.Range("I3", F.Range("I65536").[COLOR="Red"]End(xlUp).[/COLOR]Offset(-1))
  lig = Application.Match(cel, plage.Offset(, -4), 0)
  If IsNumeric(lig) Then plage(lig) = cel.Offset(, 1)
Next
End Sub
 

Discussions similaires


Haut Bas