Soustotal
Bonjour le forum
Je voudrais un ou deux codes plus affinés que je fais
de mon tableau ci joint (enregistreur)
La suite serait d'extraire les lignes de sous-totalisation vers la feuille 2
Merci par avance
Bonjour,
Une proposition basée sur un tableau (avec entêtes de colonnes) et un TCD actualisé à l'activation de sa feuille.
A te relire.
Cdlt.
Bonjour Jean Eric
je viens de voir ta proposition
Ça répond bien à ce que je cherche.
Cependant mon tableau est tout le renouvelé par importation directe d'un autre logiciel
Du coup je perd un peu les caractéristiques de mon tableau
C'est bien pour cette raison que je voulais faire en Vba
Tout de même je garde ta solution sous la main au cas ou ...
Merci encore une fois
Re,
Peux-tu préciser tes propos, quant à l'importation des données?
Cdlt.
Re
Jean Eric
Importer les données =
Je ne saisis pas les données. Elles me viennent
d'un autre logiciel sous format excel mais paramétré
de sorte que il n y ait pas de filtre et la copie commence à A1
Voila mon équation
Re,
Peux-tu envoyer un fichier brut de manipulation et représentatif de ton importation?
Et me dire si tu lances l'importation d'Excel?
Cdlt.
Bonsoir,
Je te propose une solution, mais il faut que tu crées ton classeur de macros personnelles.
La première question est : sais-tu de quoi je parle?
Quand ton classeur PERSONAL.XLSB est crée, tu copies cette procédure dans un nouveau module :
Option Explicit
'Option Private Module
Public Sub Traitement_Importation()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim lastCol As Long, lastRow As Long
Dim lo As ListObject
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim CalcMode As XlCalculation
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets(1)
With wsData
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set lo = wsData.ListObjects.Add(xlSrcRange, .Cells(1).Resize(lastRow, lastCol), , xlNo)
With lo
.Name = "tblImportation"
.TableStyle = "TableStyleLight8"
End With
End With
wb.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wsPT = ActiveSheet
ActiveSheet.Name = "TCD"
With wsPT
Set ptCache = wb.PivotCaches.Create(xlDatabase, lo.Range, 3)
Set pt = ptCache.CreatePivotTable(.Cells(1), "PT_1", , 3)
With pt
.ManualUpdate = True
With .PivotFields("Colonne2")
.Orientation = xlRowField
.Caption = "Date"
End With
With .PivotFields("Colonne7")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Caption = "Colonne7 "
End With
With .PivotFields("Colonne9")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
.NumberFormat = "#,##0"
.Caption = "Colonne9 "
End With
.RowAxisLayout xlTabularRow
.TableStyle2 = "PivotStyleMedium2"
.ManualUpdate = False
End With
End With
Application.Calculation = CalcMode
Set pt = Nothing
Set ptCache = Nothing
Set lo = Nothing
Set wsPT = Nothing: Set wsData = Nothing
Set wb = Nothing
End SubEnsuite, tu vas ajouter une commande personnalisée dans la barre d'outils Accès rapide (Options avancées d'Excel).
Tu vas certainement chercher un peu, mais tu dois trouver PERSONAL.XLSB!Traitement_Importation.
Tu l'ajoutes à la barre d'outils Accès rapide [pour tous les documents (par défaut)].
Tu enregistres le tout et tu quittes Excel.
Pour tester, tu ouvres un de tes fichiers d'importation (brut) SAP et tu lances la procédure à partir de la barre d'outils Accès rapide.
Bon si ce n'est pas clair, tu me redis.
Cdlt.
Re
Je vais tester tout cela
C'est très gentil à toi
A très vite
Re Jean Eric
J'ai testé mais le TCD que j'obtiens
est le récap de la page 1
Dons sans sous totalisation
Le fichier est ci joint
pour être plus sur que c'est ce que vous m'avez conseillé
A+
Bonjour,
Peux-tu préciser ta notion de sous-totalisation?
Et me dire quels entêtes de champs à attribuer aux colonnes?
Sinon, as-tu crée ton classeur PERSONAL.XLSB comme préconisé, ainsi une commande dans la barre d'outils d'Accès rapide, pour disposer de la procédure dans tous tes classeurs Excel?
A te relire.
Cdlt.
Edit : j'ai en effet omis la synthèse mensuelle. Je rectifie
Re,
Les lignes surlignées sont à modifier et à ajouter dans le code fourni précédemment.
Merci de répondre à mes questions.
Cdlt.
nota : si c'est okay, pense à activer la seconde ligne de code ('Option Private Module).
Option Explicit
'Option Private Module
Public Sub Traitement_Importation()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim lastCol As Long, lastRow As Long
Dim lo As ListObject
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim CalcMode As XlCalculation
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets(1)
With wsData
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set lo = wsData.ListObjects.Add(xlSrcRange, .Cells(1).Resize(lastRow, lastCol), , xlNo)
With lo
.Name = "tblImportation"
.TableStyle = "TableStyleLight8"
End With
End With
wb.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wsPT = ActiveSheet
ActiveSheet.Name = "TCD"
With wsPT
Set ptCache = wb.PivotCaches.Create(xlDatabase, lo.Range, 3)
Set pt = ptCache.CreatePivotTable(.Cells(1), "PT_1", , 3)
With pt
.ManualUpdate = True
With .PivotFields("Colonne2")
.Orientation = xlRowField
.Caption = "Mois"
End With
With .PivotFields("Colonne7")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Caption = "Colonne7 "
End With
With .PivotFields("Colonne9")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
.NumberFormat = "#,##0"
.Caption = "Colonne9 "
End With
.ManualUpdate = False
.ManualUpdate = True
.PivotFields("Mois").LabelRange.Offset(1, 0).Group Start:=True, End:=True, _
Periods:=Array(False, False, False, False, True, False, False)
.RowAxisLayout xlTabularRow
.TableStyle2 = "PivotStyleMedium2"
.ManualUpdate = False
End With
End With
Application.Calculation = CalcMode
Set pt = Nothing
Set ptCache = Nothing
Set lo = Nothing
Set wsPT = Nothing: Set wsData = Nothing
Set wb = Nothing
End SubBonjour Jean Eric
Je dois bouger toutaleur pour revenir dans l 'après midi
Je t'en dirais.
En te souhaitant une bonne semaine
Merci par avance
Bonjour Jean Eric
C'est parfait. Pile .
Question subsidiaire puisqu'on y est :
Quel sera l'effet de l'activation de l'option Private module?
Remerciements renouvelés
Re,
Content que tu sois content.
Activer la ligne 'Option Private Module rendra invisible la procédure 'Traitement_Importation' dans le gestionnaire de macros (ALT F8).
Pense à clore le sujet si tu n'as d'autres questions.
Cdlt.