XL 2016 Recopier des cellules en valeur après un clic

[Merlin258413]

Bonjour à tous
J'ai besoin de votre aide pour automatiser une recopie d'une cellule en valeur d'un mois M sur le mois M-1 , M-1 devient M-2 en faisant juste un clic.
Je dois gérer une agence qui est décomposée en secteurs. Tous les mois après la clôture, je réalise cette fiche d'analyse et je transpose par un copie coller valeur les données du mois M vers le mois M-1. Ce qui est très fastidieux et très long car je peux avoir des agences avec 25 secteurs.

Dans l'onglet Bases graphs, j'ai les données de janvier mois M (cellules en rouge) et je veux qu'en cliquant sur le bouton copie colle (colonne P ligne 17) , il recopie les montants en valeur du mois M sur le mois M-1. Les données de M-1 passe en M-2... et M-23 devient M-24 et bien sur M-24 disparait
Dans cet onglet seules les cellules sous fond rouge sont concernées.

J'espère avoir été clair et je vous remercie par avance pour votre aide
Excellente journée à vous

 

[job75]

Bonjour Merlin258413, le forum,

Voyez le fichier joint et la macro affectée au bouton :

Sub Copie_M()
Dim c As Range
Set c = Cells.Find("M", , xlValues, xlWhole)
If c Is Nothing Then Exit Sub
If MsgBox("Reporter les données du mois M sur le mois M-1 ?", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
For Each c In Range(c(2), Cells(Rows.Count, c.Column).End(xlUp))
    If IsNumeric(CStr(c)) And Not c(1, 0).HasFormula Then
        Range(Cells(c.Row, 3), c(1, 0)).Copy Cells(c.Row, 2) 'transfert à gauche
        c(1, 0) = c
    End If
Next
End Sub

Les lignes 5 6 7 37 38 39 ne sont pas traitées car il y a des formules en colonne M-1.

A+

 

[job75]

J'avais oublié d'affecter la macro au bouton.

 

[Merlin258413]

Bonjour Merlin258413, le forum,

Voyez le fichier joint et la macro affectée au bouton :

Sub Copie_M()
Dim c As Range
Set c = Cells.Find("M", , xlValues, xlWhole)
If c Is Nothing Then Exit Sub
If MsgBox("Reporter les données du mois M sur le mois M-1 ?", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
For Each c In Range(c(2), Cells(Rows.Count, c.Column).End(xlUp))
    If IsNumeric(CStr(c)) And Not c(1, 0).HasFormula Then
        Range(Cells(c.Row, 3), c(1, 0)).Copy Cells(c.Row, 2) 'transfert à gauche
        c(1, 0) = c
    End If
Next
End Sub

Les lignes 5 6 7 37 38 39 ne sont pas traitées car il y a des formules en colonne M-1.

A+

Bonjour cela fonctionne parfaitement c'est exactement ce que je voulais
Par contre je constate que les lignes 187 et 198 ne sont pas décalées vers la gauche
Est ce possible de l'intégrer dans la macro
Encore merci.

 

[Bernard_XLD]

Bonjour

Merlin258413, merci d'anonymiser vos fichiers avant publication, on peut y identifier une personne morale et les données, du coup, contreviennent au RGPD sur la protection des données.

Cordialement, @+

 

[fanch55]

Bonjour,
Dans le classeur joint,
J'ai laissé les cellules en M ayant une formule telles quelles
car je suppose que vous en aurez encore besoin .
De ce fait, le bouton ne devrait être pressé qu'une fois par mois , d'où la demande de confirmation .

 

[Merlin258413]

Bonjour,
Dans le classeur joint,
J'ai laissé les cellules en M ayant une formule telles quelles
car je suppose que vous en aurez encore besoin .
De ce fait, le bouton ne devrait être pressé qu'une fois par mois , d'où la demande de confirmation .

Bonjour merci beaucoup c'est parfait
Excellente journée

 

[job75]

Par contre je constate que les lignes 187 et 198 ne sont pas décalées vers la gauche

Il faut que les mois de ces lignes soient comme les autres.

C'est à dire commencer en colonne B et se terminer en colonne Z.

 

[Merlin258413]

Il faut que les mois de ces lignes soient comme les autres.

C'est à dire commencer en colonne B et se terminer en colonne Z.

Ok merci pour votre retour je vous souhaite une très belle journée

 

[job75]

Bon cette macro fonctionne quelles que soient les positions des mois :

Sub Copie_M()
Dim r As Range, deb As Variant, fin As Variant, i%, j%
If MsgBox("Reporter les données du mois M sur le mois M-1 ?", vbYesNo) = vbNo Then Exit Sub
For Each r In ActiveSheet.UsedRange.Rows
    deb = Application.Match("M-*", r, 0)
    fin = Application.Match("M", r, 0)
    If IsNumeric(deb) Then i = deb: j = fin
    If i Then
        If IsNumeric(CStr(r.Cells(j))) And Not r.Cells(j - 1).HasFormula Then
            Range(r.Cells(i + 1), r.Cells(j - 1)).Copy r.Cells(i)
            r.Cells(j - 1) = r.Cells(j)
        End If
    End If
Next r
End Sub

 

[Merlin258413]

Bon cette macro fonctionne quelles que soient les positions des mois :

Sub Copie_M()
Dim r As Range, deb As Variant, fin As Variant, i%, j%
If MsgBox("Reporter les données du mois M sur le mois M-1 ?", vbYesNo) = vbNo Then Exit Sub
For Each r In ActiveSheet.UsedRange.Rows
    deb = Application.Match("M-*", r, 0)
    fin = Application.Match("M", r, 0)
    If IsNumeric(deb) Then i = deb: j = fin
    If i Then
        If IsNumeric(CStr(r.Cells(j))) And Not r.Cells(j - 1).HasFormula Then
            Range(r.Cells(i + 1), r.Cells(j - 1)).Copy r.Cells(i)
            r.Cells(j - 1) = r.Cells(j)
        End If
    End If
Next r
End Sub

Bonjour je vous remercie cela fonctionne aussi parfaitement
Bonne journée et bon week end