Conversions en euros de montants

Bonjour à tous,

Dans le but d'optimiser mon fichier, j'aurai aimé créer un VBA pour convertir les montants ici en roubles, en euros.

L'idée serait de pouvoir passe des roubles en euros, puis des euros en roubles facilement pour simplifier la lecture de mes interlocuteurs.

Pensez-vous que cela est possible? Mon fichier initial contient de nombreuses feuilles quasi identiques (seul le nombre de lignes change) et je vous ai mis en pièce-jointe un fichier en exemple.

J'ai quelques bases en VBA, mais je ne sais vraiment pas comment commencer...

Merci d'avance pour votre aide.

Alexandre

Bonjour,

Essai d'adapter le code suivant à ton cas !

Sub Roubles()

    ThisWorkbook.Sheets("feuil1").Activate ' Active la feuille "feuil1"

Dim x As Long

    x = Range("A65536").End(xlUp).Row ' trouve la dernière ligne remplie de la colonne A en partant du bas et stocke sa position dans x

    Range("B1").Select ' Selectionne B1

    ActiveCell.FormulaR1C1 = "=RC[-1]*2" ' la celulle de la colonne précédente mais sur la même ligne est multipliée par deux

    Selection.AutoFill Destination:=Range("B1" & ":" & "B" & x), Type:=xlFillDefault ' Tire la formule jusqu'à la ligne trouvé stocké en X

End Sub

Cordialement,

Bonjour. Bienvenue sur le Forum

Les valeurs de Change sont inscrites en X2 et Y2

La monnaie d'affichage s'inscrit en B1

Le Bouton affiche l'option de change

Cordialement

Merci à vous 2 pour votre aide précieuse ,

J'essaye de l'adapter à mon classeur entier et je vous tiens au courant.

Re-bonjour à tous!

En fait, j'aimerais avoir un bouton unique sur ma première feuille qui convertisse les montants sur tous les autres onglets, excepté sur le premier.

J'essaye depuis tout à l'heure d'adapter des codes trouvés sur d'autres sujets du forum, mais je n'y arrive pas...

Par exemple :

Sub supprligne()

Dim ws As Worksheet
Sheets("Review 2013").Select

Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets

ws.Activate 

Pouvez-vous m'aider s'il vous plait??

Merci d'avance,

Alexandre

En fait, je cherche une ligne de code qui me permette de lancer une macro depuis une feuille sur toutes les autres feuilles, exceptée celle où se situe le bouton. Tout en sachant que la macro vient piocher des infos (les taux de change) sur la 1ère feuille.

Bonjour a tous, j'ai enfin réussi à faire une macro qui tourne sur toutes les feuilles lorsqu'on appuie sur le bouton, et qui fait parfaitement ce que je lui demande : convertir l'ensemble des montants en RUB ou en EUR.

Toutefois un autre problème existe.

Pour convertir les montants sur mes 13 onglets, la macro met 7-8 minutes, ce qui me semble énorme.

Est-ce normal ?

Sinon comment pourrais-je l'optimiser ?

En pièce jointe un exemple avec seulement 3 feuilles (confidentialité oblige), mais le code est OK

Merci d'avance pour votre aide,

Bon je clos le sujet j'ai fini par trouver la solution, voici mes lignes de code pour les intéressés :

Sub Euros()

Dim ws As Worksheet
Sheets("Review 2013").Select

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets

ws.Activate

If ws.Name <> "Review 2013" Then

Dim Cel As Range, Val, Change
Change = Sheets("Review 2013").Range("L3").Value
If IsNumeric(Change) Then
    Range("D3:U" & [A65000].End(xlUp).Row).Select
For Each Cel In Selection
Val = Cel.Value
If IsNumeric(Val) Then
If Not (IsEmpty(Val) Or Cel.HasFormula) Then

Cel.Value = Val * (Change)
End If
End If
Next Cel
End If

End If

Next ws

Sheets("Review 2013").Select
Range("L10").Select
ActiveCell.Formula = "All Amounts are in EUR"
ActiveSheet.Shapes("Bouton").Select
    Selection.Characters.Text = "Change to Roubles"
    Range("B1").Select

Application.Calculation = xlCalculationAutomatic

End Sub

'

Sub Roubles()

Dim ws As Worksheet
Sheets("Review 2013").Select

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets

ws.Activate

If ws.Name <> "Review 2013" Then

Dim Cel As Range, Val, Change
Change = Sheets("Review 2013").Range("M3").Value
If IsNumeric(Change) Then
    Range("D3:U" & [A65000].End(xlUp).Row).Select
For Each Cel In Selection
Val = Cel.Value
If IsNumeric(Val) Then
If Not (IsEmpty(Val) Or Cel.HasFormula) Then

Cel.Value = Val * (Change)
End If
End If
Next Cel
End If

End If

Next ws

Sheets("Review 2013").Select
Range("L10").Select
ActiveCell.Formula = "All Amounts are in RUB"
ActiveSheet.Shapes("Bouton").Select
    Selection.Characters.Text = "Change to Euros"
        Range("B1").Select

Application.Calculation = xlCalculationAutomatic

End Sub

'

Sub Bouton()

ActiveSheet.Shapes("Bouton").Select
If Selection.Characters.Text = "Change to Roubles" Then

     Call Roubles
Else
    Call Euros

End If
End Sub

Merci encore à Amadeus et a Hyrule