Etendre une macro sur plusieurs lignes

GFE

XLDnaute Nouveau
Bonjour,

J'essaye de mettre au point un fichier "simple" incluant une macro.
Le problème est que je suis novice dans ce domaine et que je n'arrive pas à faire ce que je souhaite.

Je m'explique, j'ai créé un premier onglet où les utilisateurs vont pouvoir indiquer (par le biais de menu déroulants) différentes informations que je souhaite récupérer sur le deuxième onglet. Le problème est que je ne sais pas "étendre" la macro pour qu'elle passe d'une ligne à une autre.
Je vous joints ce que j'ai, si cela peut aider à comprendre mon problème :

Sub Macro()
'
' Macro Macro
'
'
Sheets("Récap dépenses").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "='Fiche dépense'!R[2]C[3]"
Range("B2").Select
ActiveCell.FormulaR1C1 = "='Fiche dépense'!R[4]C[2]"
Range("C2").Select
ActiveCell.FormulaR1C1 = "='Fiche dépense'!R[6]C[1]"
Range("D2").Select
ActiveCell.FormulaR1C1 = "='Fiche dépense'!R[9]C"
Range("E2").Select
ActiveCell.FormulaR1C1 = "='Fiche dépense'!R[9]C[-1]"
Range("E2").Select
ActiveCell.FormulaR1C1 = "='Fiche dépense'!R[11]C[-1]"
Range("F2").Select
ActiveCell.FormulaR1C1 = "='Fiche dépense'!R[13]C[-2]"
Range("G2").Select
ActiveCell.FormulaR1C1 = "='Fiche dépense'!R[16]C[-3]"
Range("G3").Select
Sheets("Récap dépenses").Select
Range("A2:G2").Select.Row 1
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C7").Select

End Sub

Je souhaite bien sélectionner la plage A2:G2 mais j'aimerais que dès que j'appuie sur mon bouton enregistrer (où j'ai affecté ma macro), ce soit A3:G3 puis A4:G4 etc...

Je ne sais pas si j'ai été claire.
Si quelqu'un est en mesure de me venir en aide ;)

Merci d'avance :) !
 

st007

XLDnaute Barbatruc
Re : Etendre une macro sur plusieurs lignes

Bonjour,

Un bout de fichier vaut toujours mieux qu'un long discours.
plusieurs compréhensions possible à ta requête

on peut comprendre que
- quand l'utilisateur renseigne la colonne G, alors on copie les données A:G sur une autre feuille
une évenementielle fera çà très bien

- tu veux un formulaire à remplir et qu'au clic valider, les champs se copie à la suite de l'autre feuille

etc
etc
 

Dranreb

XLDnaute Barbatruc
Re : Etendre une macro sur plusieurs lignes

Bonjour.

Peut être :
VB:
ActiveSheet.[A2:G101].FormulaR1C1 = "=OFFSET('Fiche dépense'!R4C4,INT((COLUMN()*7+2)/3-3),ROW()-2)"
Non, pas vu, comprends plus rien.

Sauf à faire mais au coup par coup seulement :
VB:
With ActiveSheet.[A60000].End(xlUp).Offset(1).Resize(, 7)
   .FormulaR1C1 = "=OFFSET('Fiche dépense'!R4C4,INT((COLUMN()*7+2)/3-3),0)"
   .Value = .Value
   End With
ou pour plus de souplesse si la structure de la fiche venait à changer :
VB:
.FormulaR1C1 = "=INDEX('Fiche dépense'!R1C4:R18C4,CHOOSE(COLUMN(),4,6,8,11,13,15,13),1)""
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Etendre une macro sur plusieurs lignes

En tout cas elle reproduit bien la fiche, cette formule en 'Récap dépenses'!Axxx, à propager sur 7 colonnes :
Code:
=INDEX('Fiche dépense'!$D$1:$D$18;CHOISIR(COLONNE();4;6;8;11;13;15;13);1)
VB:
.FormulaR1C1 = "=INDEX('Fiche dépense'!R1C4:R18C4,CHOOSE(COLUMN(),4,6,8,11,13,15,13),1)"
 
Dernière édition:

st007

XLDnaute Barbatruc
Re : Etendre une macro sur plusieurs lignes

Re,

comme quoi l'interpretation, j'en suis au code :
Code:
Sub copie()


Range("D4").Copy Sheets("Récap dépenses").Range("A65536").End(xlUp).Offset(1, 0) 'site
Range("D6").Copy Sheets("Récap dépenses").Range("A65536").End(xlUp).Offset(0, 1) 'nature
Range("D8").Copy Sheets("Récap dépenses").Range("A65536").End(xlUp).Offset(0, 2) 'date
Range("D11").Copy Sheets("Récap dépenses").Range("A65536").End(xlUp).Offset(0, 3) 'montant
Range("D13").Copy Sheets("Récap dépenses").Range("A65536").End(xlUp).Offset(0, 4) 'taux tva
Range("D15").Copy Sheets("Récap dépenses").Range("A65536").End(xlUp).Offset(0, 5) 'montant htnd
Range("D18").Copy Sheets("Récap dépenses").Range("A65536").End(xlUp).Offset(0, 6) 'Fournisseur
Range("D4:D18").ClearContents
End Sub
 

BigDaddy154

XLDnaute Junior
Re : Etendre une macro sur plusieurs lignes

Bonjour tout le monde,

essaye ce code :

Code:
Sub Sauvegarder()
    Application.ScreenUpdating = False
    If Range("d4") = "" Or Range("d6") = "" Or Range("d8") = "" Or Range("d11") = "" Or Range("d13") = "" Or Range("d15") = "" Or Range("d18") = "" Then 'Vérification que tous les champs soient remplis
        MsgBox "Vous devez impérativement remplir tout les champs", 64, "Warning" 'Message si au moins un champs n'est pas rempli
    Else
        Set informations = Union(Range("d4"), Range("d6"), Range("d8"), Range("d11"), Range("d13"), Range("d15"), Range("d18")) 'déclaration des cellules avec des infos
        With Sheets("Récap dépenses")
            dlf2 = .Range("a" & Rows.Count).End(xlUp).Row + 1 'calcul de la dernière ligne remplie dans la colonne A de la feuille Récap dépenses
            informations.Copy 'on copie les champs d'infos
            .Range("a" & dlf2).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'on les colles sur la 1ere ligne vide de la feuille Récap dépenses
            .Range("f" & dlf2, "d" & dlf2).NumberFormat = "#,##0.00 $" 'formatage de la cellule f & d en monétaire
            informations.ClearContents 'on efface les cellules d'information
            Range("d15").FormulaR1C1Local = "=SI(OU(L11C4="""";L13C4="""");"""";L11C4*(1+L13C4))" 'on remet la formule dans la cellule d15
            .Range("e" & dlf2).Style = "Percent" 'formatage de la cellule e en pourcentage
        End With
        MsgBox "Sauvegarde réussie", 64, "Warning" 'message pour indiquer que la sauvegarde est ok
        Application.CutCopyMode = False
    End If
    Application.ScreenUpdating = True
End Sub

Cordialement.
 

Discussions similaires

Réponses
1
Affichages
112