Excel vba problème

Fermé

Iglooo Messages postés 1 Date d'inscription jeudi 18 octobre 2007 Statut Membre Dernière intervention 18 octobre 2007 - 18 oct. 2007 à 14:42
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 - 18 oct. 2007 à 22:46

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:

Excel vba problème
Liste déroulante excel - Guide
Formule excel - Guide
Si et excel - Guide
Aller à la ligne excel - Guide
Mise en forme conditionnelle excel - Guide

1 réponse

Réponse 1 / 1

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 685
18 oct. 2007 à 22:46

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

Discussions similaires

Excel VBA : Récupérer la valeur d'une cellule

Discussions similaires

Newsletters