Etirer une formule en VBA

Bonsoir,

Je vous sollicite car j'aimerai de l'aide sur un petit détail de mon fichier.

Dans mon userform "générateur" je n'arrive pas à écrire (en vba bien sur )une macro "recopier/ étirer" ("CalEcrireForm").

Ma formule contenue sur l'onglet WsCal sur les lignes A369-A375 devrait se copier jusqu'à mon denier agent. Sachant que mon nombre d'agent varie à chaque utilisation.

Je vous transmet un exemple ou les agents sont déjà générés.

Sub CalEcrireForm()
Dim a, i%
WsPrm.Range("E369:BB375").ClearContents
a = Range(CmbSect).Value
For i = 1 To (UBound(a))
WsPrm.Cells(i + 368, 5) = a(i, 1)
Next
End Sub

Si vous avez des idées je suis prenneur.

Bonjour,

Pour étirer une formule vers le bas c'est AutoFill :

Sub Test()

    Range("D369").FormulaLocal = "=NB.SI(D$2:D$367;$A369)"
    Range("D369").AutoFill Range("D369:D375")

End Sub

Ok merci theze,

C est une première piste Je continue de chercher pour incrémenté en fonction du nombre d agent

Re,

Si tu veux l'avoir en milieu de feuille, il faut chercher la cellule la plus basse depuis le bas de la feuille puis à partir de cette cellule, remonter pour chercher la dernière non vide. Teste ceci pour voir :

Sub Test()

    Dim Cel1 As Range
    Dim Cel2 As Range

    With ActiveSheet

        Set Cel2 = .Cells(Rows.Count, 1).End(xlUp)
        Set Cel1 = .Cells(Cel2.Row, 1).End(xlUp)

        Cel1.Offset(, 3).FormulaLocal = "=NB.SI(D$2:D$367;$A369)"
        Cel1.Offset(, 3).AutoFill Range(Cel1.Offset(, 3), Cel2.Offset(, 3))

    End With

End Sub

Attention, j'ai un bug sur ton classeur en utilisant ce code "Erreur définie par l'application ou par l'objet" alors que ça fonctionne très bien sur une copie de ta feuille Cal dans un autre classeur ! Comme je suis sous Excel 2003, il ce peut que ce soit dû à ça ? A tester !

Je regarde ca des que je suis devant mon pc, merci

Bonsoir theze

je viens de tester mais j obtient rien même pas une erreur. J'ai ajouter la sélection de la dernière ligne mais rien ne se passe .

Ou j'ai pas bien compris ce que je devais faire

Sub test()
    Dim Cel1 As Range
    Dim Cel2 As Range

    With ActiveSheet
    WsCal.[A375].Select 'ici selection de la derniere ligne
        Set Cel2 = .Cells(Rows.Count, 1).End(xlUp)
        Set Cel1 = .Cells(Cel2.Row, 1).End(xlUp)

        Cel1.Offset(, 3).FormulaLocal = "=NB.SI(D$2:D$367;$A369)"
        Cel1.Offset(, 3).AutoFill Range(Cel1.Offset(, 3), Cel2.Offset(, 3))

    End With

End Sub

Car dans les deux premières lignes tu selectionnes la ligne 369 et 375 et ensuite j'ai pas bien compris.

Merci si tu as d'autres explications

Bonjour,

Essaie ce code :

Sub Test()
Dim ColDeb As Integer, ColFin As Integer
Dim LigDeb As Long, LigFin As Long
    With WsCal
        'Colonne correspondant au premier agent
        ColDeb = 4
        'Colonne correspondant au dernier agent
        ColFin = .Cells(1, Columns.Count).End(xlToLeft).Column
        'Première ligne
        LigDeb = 369
        'Dernière ligne
        LigFin = 375
        'Mise en place de la formule en D369
        .Cells(LigDeb, ColDeb).FormulaLocal = "=NB.SI(D$2:D$367;$A369)"
        'recopie incrémentée dans la plage D369:D375
        .Cells(LigDeb, ColDeb).AutoFill _
        Destination:=.Range(.Cells(LigDeb, ColDeb), .Cells(LigFin, ColDeb)), Type:=xlFillDefault
        'recopie incrémentée dans la plage D369:AB375
        .Range(.Cells(LigDeb, ColDeb), .Cells(LigFin, ColDeb)).AutoFill _
        Destination:=.Range(.Cells(LigDeb, ColDeb), .Cells(LigFin, ColFin)), Type:=xlFillDefault
    End With
End Sub

A+

Bonsoir frangy,

Merci ! C'est impeccable, je valide

Merci à vous deux pour les pistes et les solutions apportées