Etirer une formule sur plusieurs colonnes en VBA

Bonjour,

Je travaille actuellement sur un fichier Excel qui importe un fichier CSV dans un premier temps puis traite les données dans différents tableaux via du code VBA.

Et c'est là que mon problème commence :

J'ai un tableau avec plusieurs colonnes et lignes qui doit se remplir avec une formule écrite en VBA.

' Récupération des consommations moyennes des véhicules
Set PlgRé2 = Feuil1.[A16].Resize(Feuil1.[A65000].End(xlUp).Row - 15, 7)
PlgRé2.Columns(2).FormulaR1C1 = "=IFERROR(((SUMIFS(R2C12:R9C12,R2C3:R9C3,RC1,R2C4:R9C4,R15C)*100)/(SUMIFS(R2C10:R9C10,R2C3:R9C3,RC1,R2C4:R9C4,R15C))),""0,00"")"

Le code ci-dessus me remplit bien la colonne B mais pas les colonnes C et D donc pour le moment j'utilise le code ci-dessous pour étirer ma formule et remplir mes colonnes C et D :

LFinD = Feuil1.[B65000].End(xlUp).Row

    Range("B16:B" & LFinD & "").Select
   Selection.AutoFill Destination:=Range("B16:D" & LFinD & ""), Type:=xlFillDefault

Le problème est que le tableau ci-dessus est un import d'un fichier CSV et donc le nombre de lignes et de colonnes à calculer dans mon 2ème tableau peut varier. C'est donc là que le code ci-dessous a des limites car je m'arrête à la colonne D.

Ma question est donc de savoir comment je peux passer en variable le nombre de colonnes où il faut que ma formule se calcule?

Je vous mets en pièce jointe un exemple pour que ce soit plus clair.

Merci de votre aide car là je bloque malgré mes recherches faites sur le net et mes différentes tentatives...

Grhum29

36test-macro.xlsm (28.98 Ko)

Bonsoir,

Copie cette procédure dans un module standard.

Elle crée un tableau dynamique, puis un tableau croisé dynamique (TCD) avec un champ calculé pour la consommation moyenne.

A te relire, pour un complément d'informations.

Cdlt.

Option Explicit

Public Sub Consommation_moyenne()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim ptCache As pivotCache
Dim pt As PivotTable
Dim modeCalc As XlCalculation

    With Application
        modeCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Feuil1")

    On Error Resume Next
    wb.Worksheets("TCD").Delete
    On Error GoTo 0

    Application.DisplayAlerts = True

    With ws
        Set lo = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
        With lo
            .Name = "Tableau1"
            .TableStyle = ""
        End With
    End With
    wb.Worksheets.Add After:=wb.Worksheets(Worksheets.Count)
    ActiveSheet.Name = "TCD"
    Set ptCache = wb.PivotCaches.Create(xlDatabase, lo.Range, 3)
    Set pt = ptCache.CreatePivotTable(Cells(1), "TCD1", , 3)
    With pt
        .ManualUpdate = True
        .AddFields RowFields:="Site géographique", ColumnFields:="Modéle véhicule"
        .CalculatedFields.Add "Conso moyenne", _
                "='Nb, litres consommés' /'Nb, kilomètres parcourus' *100", True
        With .PivotFields("Conso moyenne")
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "#,##0.00"
            .Caption = ChrW(931) & " Conso moyenne"
        End With
        .RowAxisLayout xlTabularRow
        .TableStyle2 = ""
        .DisplayErrorString = True
        .ManualUpdate = False
    End With

    Application.Calculation = modeCalc

    Set pt = Nothing
    Set ptCache = Nothing
    Set lo = Nothing
    Set ws = Nothing
    Set wb = Nothing

End Sub
Rechercher des sujets similaires à "etirer formule colonnes vba"