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

job75 à dit:

Bonjour Merlin258413, le forum,

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

VB:

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+

Cliquez pour agrandir...

fanch55 à dit:

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 .

Cliquez pour agrandir...

Merlin258413 à dit:

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

Cliquez pour agrandir...

job75 à dit:

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.

Cliquez pour agrandir...

job75 à dit:

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

VB:

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

Cliquez pour agrandir...