étirer une plage en vba

Résolu/Fermé
jc80 Messages postés 4149 Date d'inscription mardi 5 février 2013 Statut Membre Dernière intervention 25 février 2019 - Modifié par jc80 le 4/09/2016 à 14:50
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 - 4 sept. 2016 à 17:51
Bonjour,
J'ai trouvé un code sur ccm mais qui pose problème.
En cellule G1 G6 j'ai Mai 2016
En cellule G2 G7 j'ai une formule avec ce code je souhaiterais avoir en H1 H6 Juin 2016
et en H2 H7 le formule appropriée "faire comme un étirement des cellules vers la droite
Le principe est d'ajouter 1 mois a chaque fois

Ci-dessous le code le beug est sur la ligne en gras

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Range("G1,G2,G6,G7").Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Selection.Offset(0, 1).Select

Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Select
End Sub

Merci pour votre aide
Cordialement


4 réponses

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
4 sept. 2016 à 15:37
Bonjour,

J'ai trouvé un code sur ccm mais qui pose problème.

Non seulement il pose problème mais il a peu de chance de fonctionner ainsi car même en le faisant manuellement cela ne fonctionne pas il faudrait que tu nous donnes la formule en question pour que l'on te l'adapte.
1
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
4 sept. 2016 à 16:18
Bonjour,

Avec ce que j'ai compris, je te propose ceci :
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    With Range("G1")
        .Offset(0, 1).Value = DateAdd("m", 1, .Value)
        .Copy
        .Offset(0, 1).PasteSpecial Paste:=xlPasteFormats
    End With
    With Range("G2")
        .Copy
        .Offset(0, 1).PasteSpecial Paste:=xlPasteFormulas
    End With
    With Range("G6")
        .Offset(0, 1).Value = DateAdd("m", 1, .Value)
        .Copy
        .Offset(0, 1).PasteSpecial Paste:=xlPasteFormats
    End With
    With Range("G7")
        .Copy
        .Offset(0, 1).PasteSpecial Paste:=xlPasteFormulas
    End With
Application.CutCopyMode = False
End Sub
1
jc80 Messages postés 4149 Date d'inscription mardi 5 février 2013 Statut Membre Dernière intervention 25 février 2019 1 422
4 sept. 2016 à 15:43
Bonjour gbinforme
Merci, pour ton aide
Formule en G2 =SOMME.SI.ENS($C:$C;$A:$A;">="&G1;$A:$A;"<="&FIN.MOIS(G1;0))
Formule en G7 =SOMME.SI.ENS($E:$E;$A:$A;">="&G6;$A:$A;"<="&FIN.MOIS(G6;0))
G1 et G6 sont au format mmm-aa
Cordialement
0
jc80 Messages postés 4149 Date d'inscription mardi 5 février 2013 Statut Membre Dernière intervention 25 février 2019 1 422
Modifié par jc80 le 4/09/2016 à 16:36
Ta formule marche super pour 1 mois
exemple de Mai en G1 passe à Juin H1
Ce que je souhaiterais avoir ,c'est de pouvoir tous les mois ajouter 1 mois
exemple de H1 Juin passe à I1 Juillet.Ainsi de suite Aout septembre ...
j'espère que tu me comprends.
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
Modifié par gbinforme le 4/09/2016 à 16:51
Je te comprends parfaitement et je te modifie cela. ;-)
Private Sub CommandButton1_Click()
Dim col As Integer
Application.ScreenUpdating = False
    col = Cells(1, Columns.Count).End(xlToLeft).Column
    With Cells(1, col)
        .Offset(0, 1).Value = DateAdd("m", 1, .Value)
       .Copy
        .Offset(0, 1).PasteSpecial Paste:=xlPasteFormats
    End With
    With Cells(2, col)
        .Copy
        .Offset(0, 1).PasteSpecial Paste:=xlPasteFormulas
    End With
    With Cells(6, col)
        .Offset(0, 1).Value = DateAdd("m", 1, .Value)
        .Copy
        .Offset(0, 1).PasteSpecial Paste:=xlPasteFormats
    End With
    With Cells(7, col)
        .Copy
        .Offset(0, 1).PasteSpecial Paste:=xlPasteFormulas
    End With
Application.CutCopyMode = False
End Sub
0
jc80 Messages postés 4149 Date d'inscription mardi 5 février 2013 Statut Membre Dernière intervention 25 février 2019 1 422 > gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020
4 sept. 2016 à 17:41
Merci pour toutes tes solutions .
Cela fonctionne à merveille.
Merci encore pour ton aide
Cordialement
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
4 sept. 2016 à 17:51
Merci du retour sympathique et bonne continuation.
0