Excel vba problème

Iglooo Messages postés 1 Date d'inscription   Statut Membre Dernière intervention   -  
gbinforme Messages postés 14946 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,
SVP, J'ai un classeur Excel qui contient 13 feuilles nommées " Janvier, Février,..., Décembre, Total ventes". Chacune de ces feuilles contient un tableau de mêmes dimensions ( en lignes les produits et en colonnes les villes, l'intersection est la vente du produit dans la ville correspondante du mois pour chacun des produits) mais pas de mêmes références e lignes et de colonnes. Je voudrais trouver une macro qui me permettrait de faire le total des ventes mensuelles dans la feuilles nommée "Total" qui contenait un tableau de même dimension aussi que les autres produits. Merci.
A voir également:

1 réponse

Réponse 1 / 1
gbinforme Messages postés 14946 Date d'inscription   Statut Contributeur Dernière intervention   4 724
 
bonjour

Ta formulation est un peu confuse et j'ai compris que :
- tu avais des feuilles mensuelles avec en ligne 1 des noms de villes sur les colonnes (à partir de la colonne 2)
- tu avais des feuilles mensuelles avec en colonne 1 des noms de produits (à partir de la ligne 2)
- pas forcément les mêmes produits et les mêmes villes chaque mois.
- que tu voulais une feuille "total" cumulant les produits mensuels identiques sur les villes identiques.

Je voudrais trouver une macro
Elle est à placer dans la feuille total en VBA (ctrl + F11) et elle se déclenche lorsque l'on choisis l'onglet correspondant. 
Option Explicit
Private Sub Worksheet_Activate()
Dim c As Integer    ' colonne mois
Dim ct As Integer   ' colonne total
Dim f As Integer    ' feuille mois
Dim l As Long       ' ligne mois
Dim lt As Long      ' ligne total
Dim ft As String    ' feuille total
ft = ActiveSheet.Name
Application.ScreenUpdating = False
Cells.ClearContents
For f = 1 To Sheets.Count
    If Sheets(f).Name <> ft Then    ' traitement des feuilles non total
        For l = 2 To Sheets(f).Cells.SpecialCells(xlCellTypeLastCell).Row ' lignes
            ' recherche et création ligne total
            For lt = 2 To Sheets(ft).Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                If Sheets(ft).Cells(lt, 1).Value = Sheets(f).Cells(l, 1).Value Then Exit For
                If Sheets(ft).Cells(lt, 1).Value > Sheets(f).Cells(l, 1).Value _
                    Or Sheets(ft).Cells(lt, 1).Value = "" Then
                    Sheets(ft).Cells(lt, 1).EntireRow.Insert
                    Sheets(ft).Cells(lt, 1).Value = Sheets(f).Cells(l, 1).Value
                    Exit For
                End If
            Next lt
            For c = 2 To Sheets(f).Cells.SpecialCells(xlCellTypeLastCell).Column ' colonnes
             ' recherche et création colonne total
               For ct = 2 To Sheets(ft).Cells.SpecialCells(xlCellTypeLastCell).Column + 1
                    If Sheets(ft).Cells(1, ct).Value = Sheets(f).Cells(1, c).Value Then Exit For
                    If Sheets(ft).Cells(1, ct).Value > Sheets(f).Cells(1, c).Value _
                        Or Sheets(ft).Cells(1, ct).Value = "" Then
                        Sheets(ft).Cells(1, ct).EntireColumn.Insert
                        Sheets(ft).Cells(1, ct).Value = Sheets(f).Cells(1, c).Value
                        Exit For
                    End If
                Next ct         ' total sur intersection trouvée
                If IsNumeric(Sheets(f).Cells(l, c).Value) Then
                    Sheets(ft).Cells(lt, ct).Value = Sheets(ft).Cells(lt, ct).Value _
                        + Sheets(f).Cells(l, c).Value
                End If
            Next c
        Next l
    End If
Next f
Application.ScreenUpdating = True
End Sub
0