Créer un convertisseur automatique de devises au sein d'un tableau

sourisnet

XLDnaute Nouveau
Chers tous, Chères toutes,

J'ai créé pour mes filiales à l'étranger (je suis assistante RH dans une petite PME internationale) un outil de suivi de leur "masse salariale" (wage bill en anglais), en gros, l'évolution d'une année sur l'autre de la somme des salaires de l'ensemble des employés.

Chaque filiale me remplit ce document en monnaie locale.

J'aimerais pouvoir me simplifier la vie et pouvoir convertir automatiquement leurs données chiffrées à l'aide d'un convertisseur en fonction du pays d'origine (et du taux de change qui est ou qui sera en vigueur).

Vous trouverez ce convertisseur en pièce jointe, il contient:

- sur l'onglet 1: une reproduction exacte du tableau que chaque filiale doit remplir en monnaie locale (ils me remplissent les cases blanches, le reste n'est que formules)
- sur l'onglet 2: la table de change 2009-2016 (années étudiées) pour convertir la monnaie locale en euros (coefficients multiplicateurs).

Je souhaiterais pouvoir:

1. copier-coller (transférer) les données que je reçois pour chaque pays dans le tableau de l'onglet 1 (uniquement les cases blanches du tableau).
2. sélectionner le pays correspondant aux données copiées.
3. obtenir dans un NOUVEL ONGLET une copie de l'onglet 1 avec toutes les données converties en euros, colonne par colonne en fonction de l'année.

colonne H: coefficient multiplicateur du pays en 2009
colonne I: coefficient multiplicateur du pays en 2010
colonne J: coefficient multiplicateur du pays en 2011
colonne K: coefficient multiplicateur du pays en 2012
colonne L: coefficient multiplicateur du pays en 2013
colonne M: coefficient multiplicateur du pays en 2014
colonne N: coefficient multiplicateur du pays en 2015
colonne O: coefficient multiplicateur du pays en 2016

Je vous serais entièrement reconnaissante si vous pouviez me simplifier la vie en trouvant une solution ou une méthodologie.

Je vous remercie.

Bien à vous,

Sourisnet
 

Pièces jointes

  • CONVERTISSEUR-TEST.zip
    45.7 KB · Affichages: 413

job75

XLDnaute Barbatruc
Re : Créer un convertisseur automatique de devises au sein d'un tableau

Bonjour sourisnet, le forum,

Pas sûr d'avoir bien compris la plage à convertir, mais voici une macro.

Elle est à placer dans le fichier de restitution.

Elle doit être lancée quand le classeur à étudier (celui d'un pays) est le classeur actif (au 1er plan).

Code:
Sub Convertir()
Dim W As Workbook, F As Worksheet, F1 As Worksheet, F2 As Worksheet, plage As Range, pays$
Dim cel As Range, an As Integer, taux As Double, c As Integer, i As Integer, j As Integer
Set W = ActiveWorkbook 'le classeur à traiter doit être le classeur actif
Set F = W.Sheets("WAGE BILL Kcurrency")
Set F1 = ThisWorkbook.Sheets("WAGE BILL Kcurrency") 'feuille de restitution
Set F2 = ThisWorkbook.Sheets("TABLE DE CHANGE 2009-16")
Set plage = F1.Range("G9:G10,G13:N14,G16:N19,G22:N22,G31:N34") 'plage à renseigner
pays = F.Range("D2")
On Error Resume Next
'---Renseigne la feuille de restitution---
F1.Range("D2") = pays 'copie le pays
plage.ClearContents 'efface la plage
For Each cel In plage
  an = 0 'au cas où l'année n'est pas trouvée
  an = Right(F1.Cells(6, cel.Column), 4) 'année concernée
  taux = 0 'au cas où le taux n'est pas trouvé
  taux = F2.Cells(Application.Match(pays, F2.Columns(1), 0), Application.Match(an, F2.Rows(1), 0))
  If taux Then cel = F.Range(cel.Address) * taux 'conversion en euros
Next
If pays = "" Then MsgBox "Le pays n'a pas été renseigné": Exit Sub
Application.ScreenUpdating = False
With ThisWorkbook
  '---Crée le nouvel onglet s'il n'existe pas---
  If IsError(.Sheets(pays).Name) Then
    F1.Copy After:=.Sheets(.Sheets.Count)
    .Sheets(.Sheets.Count).Name = pays
  Else
    F1.Cells.Copy .Sheets(pays).Cells
  End If
  '---Classe les onglets alphabétiquement---
  c = .Sheets.Count
  For i = 3 To c
    For j = i + 1 To c
      If .Sheets(i).Name > .Sheets(j).Name Then
        .Sheets(i).Move After:=.Sheets(j)
        i = i - 1
        Exit For
       End If
    Next
  Next
End With
W.Activate 'réactive le classeur étudié
End Sub

A+
 
Dernière édition:

sourisnet

XLDnaute Nouveau
Re : Créer un convertisseur automatique de devises au sein d'un tableau

Bonjour et merci tout d'abord!
Malheureusement, j'ai essayé d'insérer la macro mais quand je l'exécute elle me remet toutes les données tapées dans l'onglet 1 à zéro et me créé un onglet correspondant au pays mais sans les données converties en euros.

En fait, ce que je souhaiterais, c'est uniquement 3 onglets:
- sur l'onglet 1: une reproduction exacte du tableau que chaque filiale doit remplir en monnaie locale (ils me remplissent les cases blanches, le reste n'est que formules) afin que je copie-colle les données sur ce premier onglet en fonction de chaque retour
- sur l’onglet 2 : une copie de l’onglet 1 avec les données de l'onglet 1 qui se convertiraient automatiquement en euros (année après année) en fonction du pays coché dans l'onglet 1
- sur l'onglet 3: la table de change 2009-2016 (années étudiées) pour convertir les données remplies en monnaie locale dans l'onglet 1 en euros (coefficients multiplicateurs).

Merci d'avance!

Sourisnet
 

job75

XLDnaute Barbatruc
Re : Créer un convertisseur automatique de devises au sein d'un tableau

Re,

La macro précédente créait un onglet pour chaque pays étudié.

Celle-ci, comme vous le demandez, est donc plus simple :

Code:
Sub Convertir()
Dim F As Worksheet, pays$, F1 As Worksheet, F2 As Worksheet
Dim adresse$, cel As Range, an As Integer, taux As Double
Set F = ActiveWorkbook.Sheets("WAGE BILL Kcurrency") 'le classeur à traiter doit être le classeur actif
pays = F.Range("D2")
If pays = "" Then MsgBox "Le pays n'a pas été renseigné !": Exit Sub
On Error Resume Next
ThisWorkbook.Activate
Set F1 = Sheets("WAGE BILL Kcurrency")
Set F2 = Sheets("TABLE DE CHANGE 2009-16")
adresse = "G9:G10,G13:N14,G16:N19,G22:N22,G31:N34" 'adresse de la plage à renseigner
'---Copie les cellules du fichier actif sur F1---
For Each cel In F1.Range(adresse)
  cel = F.Range(cel.Address)
Next
'---Crée l'onglet "CONVERSION" et/ou copie F1---
If IsError(Sheets("CONVERSION").Name) Then
  F1.Copy After:=F1
  Sheets(F1.Index + 1).Name = "CONVERSION"
Else
  F1.Cells.Copy Sheets("CONVERSION").Cells
End If
'---Convertit l'onglet "CONVERSION"---
For Each cel In Sheets("CONVERSION").Range(adresse) 'plage à convertir
  If cel <> "" Then
    an = 0 'au cas où l'année n'est pas trouvée
    an = Right(F1.Cells(6, cel.Column), 4) 'année concernée
    taux = 0 'au cas où le taux n'est pas trouvé
    taux = F2.Cells(Application.Match(pays, F2.Columns(1), 0), Application.Match(an, F2.Rows(1), 0))
    If taux Then cel = cel * taux Else cel = "###" 'conversion en euros
  End If
Next
Sheets("CONVERSION").Activate
End Sub

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 308
Messages
2 087 105
Membres
103 469
dernier inscrit
Thibz