Coller transposé en effectuant des sous totaux

Bonjour à tout le monde,

je vous soumets mon projet en espérant que quelqu'un veuille bien m'aider.

j'ai un macro qui fait copie coller d'une plage en transposé vers une autre feuille. Je voudrais après collage effectuer les sous totaux des colonnes en rouge dans la feuille "Copie coller tranposée valeurs".

Je pourrais bien effectuer ces operations sur la feuille "Valeurs_cloture" avant d'effectuer la copie la transposé mais en effet j'ai une autre macro qui me récupère les données dans d'autres fichiers vers le classeur Test_copie_coller_transpoée feuille "Valeurs_cloture" . En effectuant la récupération il supprimer le calcul que j'avais mis dans la feuille et me met les valeurs jours de ces colonnes en couleur (comme sur la feuille "Valeurs_cloture" ligne colorées). Du coup je dois refaire le calcul sur plusieurs colonnes.

Je voudrais refaire les calculs automatiquement après le collage.

Sub copie_coller_transposé()

Set RANGE1 = Worksheets("Valeurs_cloture").Range("A3:XFD57")

RANGE1.Copy

Worksheets("Copie coller tranposée valeurs").Cells(1, 1).PasteSpecial Transpose:=True

End Sub

Salut BidExcel,

devrait faire le travail, je pense, d'après mes tests...
Un double-clic sur la feuille 'Valeurs_Cloture' démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, iRow%, iCol%, sCol1$, iCol2$
'
Cancel = True
'
Application.ScreenUpdating = False
Application.Calculation = xlManual
'
tTab = Range("B3").Resize(Range("A" & Rows.Count).End(xlUp).Row - 2, Cells(3, Columns.Count).End(xlToLeft).Column - 1).Value
'
With Worksheets("RECAP")
    iRow = .Range("A" & Rows.Count).End(xlUp).Row
    iCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range("A2").Resize(UBound(tTab, 2), UBound(tTab, 1)).FormulaLocal = WorksheetFunction.Transpose(tTab)
    For x = 2 To iCol - 2
        If sCol1 = "" Then sCol1 = .Cells(1, x)
        If InStr(.Cells(1, x), "BRVM") > 0 Then _
            sCol2 = .Cells(1, x - 1): _
            .Range(fctCol(x) & 2).FormulaLocal = _
                IIf(sCol1 = sCol2, "=[@" & sCol1 & "]", "=SOMME(Tableau5[@[" & sCol1 & "]:[" & sCol2 & "]])"): _
            .Range(fctCol(x) & 2).AutoFill Destination:=.Range(fctCol(x) & "2:" & fctCol(x) & iRow): _
            sCol1 = ""
    Next
    .Range(fctCol(iCol) & 2).FormulaLocal = _
        "=SOMME.SI(Tableau5[[#En-têtes];[PALC]:[BRVM-TRP]];""BRVM*"";Tableau5[@[PALC]:[BRVM-TRP]])"
    .Range(fctCol(iCol) & 2).AutoFill Destination:=.Range(fctCol(iCol) & "2:" & fctCol(iCol) & iRow)
End With
'
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
'
End Sub

A+

Merci beaucoup pour ton aide c'est super ta solution me convient

Cdt

Le miracle de Pâques : BidExcel a ressuscité !

Content que ça fonctionne car j'ai complètement oublié l'affaire!

A+

C'est lourd de sens Pâques. J'anétais plutôt hors réseau.

Bonne semaine à toi curulis57