VBA - Aide pour Programmation erronée

jorisphi

XLDnaute Occasionnel
Bonjour à tous

J’ai une programmation VBA, mais je n’arrive pas à l’appliquer.
Parfois elle ne me donne rien, soit elle me donne des résultats dans une autre colonne
La même macro pour les boutons 1 à 14 ( ligne 2) ne s’active donc pas correctement

Je ne suis pas un Expert en VBA
Quelqu’un pourrait- m’aider et la corriger dans mon fichier joint ?

En résumé, voici :
Ma macro dans mon fichier s’appelle « PresAbs »
Cette macro doit reporter les valeurs de mon tableau 2, dans mon tableau 1, et ce, en lançant la macro avec les boutons repris en ligne 2 (Tableau 1)
Attention , les valeurs C196 à C220 (du tableau 2) doivent être incrémentées dans le tableau 1, soit dans C3 à C51, et ce, une ligne sur deux, car j’ai des lignes groupées

Attention , un MSG doit m’avertir avant d’exécuter la macro,
soit « Cette Commande va écraser les montants déjà encodés, Voulez-vous continuer ? OUI-NON »

J’aimerai aussi :
- une et seule macro pour les boutons 1 à 14
- Tirer la macro (Bouton 1) vers la droite et qu’elle se recopie dans les cellules suivantes
Sans écraser les noms des colonnes de la ligne 2


Je joins mon fichier avec ma programmation
Merci d’avance pour votre aide
 

Pièces jointes

  • TEST(2).zip
    47.9 KB · Affichages: 30
  • TEST(2).zip
    47.9 KB · Affichages: 31
  • TEST(2).zip
    47.9 KB · Affichages: 29
Dernière édition:

jp14

XLDnaute Barbatruc
Re : VBA - Aide pour Programmation erronée

Bonsoir

Bonjour à tous

Ma macro dans mon fichier s’appelle « PresAbs »
Cette macro doit reporter les valeurs de mon tableau 2, dans mon tableau 1,
Merci d’avance pour votre aide

La macro ne peut fonctionner correctement du fait que la colonne utilisé est la colonne de la cellule active : col = ActiveCell.Column.
Pour affecter une colonne à l'action il suffit d'utiliser une macro évènementielle comme Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) macro à mettre dans la feuille.


Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
With Sheets(Target.Worksheet.Name)
    If Not Intersect(Target, Range("c2:p2")) Is Nothing Then
        SendKeys "{RIGHT}"
        If vbYes = MsgBox("Cette Commande va écraser les montants déjà encodés" & vbCr & vbCr & vbCr & _
            "           Voulez-vous continuer ?", vbExclamation + vbYesNo, "Copie") Then
            col = Target.Column
            Lig = 196
            For k = 3 To 51 Step 2
            Cells(k, col) = Cells(Lig, col).Value
            Lig = Lig + 1
            Next
        End If
    End If

End With

End Sub

Il faut supprimer tous les boutons.

A tester
 

Discussions similaires

Réponses
4
Affichages
220