IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

TCD via Macro, erreur d'exécution '1004' [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Juillet 2014
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Meurthe et Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2014
    Messages : 4
    Points : 4
    Points
    4
    Par défaut TCD via Macro, erreur d'exécution '1004'
    Bonjour à toutes et à tous,

    Je vous contacte car j'ai besoin d'aide, sur un fichier excel appelé "Calcul" j'ai un bouton qui lance une macro, cette macro viens extraire certaines données d'un autre classeur excel appelé "Stock". Sur le classeur stock j'ai des milliers de ligne, une ligne correspond à une référence articles et dans une colonne j'ai une quantité. La meme référence peut se retrouver sur plusieurs lignes, le but de la macro est d'envoyé sur mon classeur "Calcul" la liste des références avec la somme des quantités pour chacunes d'elles. Je me suis servis plusieurs fois de ce fichier "Calcul" pour une catégorie d'articles.
    J'ai copier mon fichier calcul pour l'utiliser avec un autre fichier stock qui est exactement de la même forme que le premier, lorsque je lance ma macro cela ne fonctionne pas.

    J'ai une fenetre qui apparait

    Erreur d'exécution 1004.
    Cette commande requiert au moins deux lignes de données sources. Vous ne pouvez pas l'utiliser sur une seule ligne de données. Essayez la méthode suivante:
    Si vous utilisez un filtre avancé, selectionnez une plage de cellules qui contient au moins deux lignes de données. Puis cliquez à nouveau sur la commande Filtre élaboré.
    Continuer
    Images attachées Images attachées  

  2. #2
    Expert confirmé Avatar de illight
    Homme Profil pro
    Analyste décisionnel
    Inscrit en
    Septembre 2005
    Messages
    2 342
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Analyste décisionnel
    Secteur : Service public

    Informations forums :
    Inscription : Septembre 2005
    Messages : 2 342
    Points : 4 299
    Points
    4 299
    Par défaut
    Le message est, je pense, assez explicite : pour faire ton TCD et l'actualiser, il te faut des données. A mon avis, la source de ton Tableau Croisé à un souci lors de l'actualisation.

    As-tu essayé de faire le process manuellement, pour voir ce qui colle pas ? Essaye de faire du pas-à-pas, et juste avant d'actualiser ton tableau regarde les différents éléments :
    - données sources de ton TCD, regarde s'il y a des données
    - regarde dans tes données sources si une colonne n'aurait pas disparu, colonne qui est un des champs de ton TCD

    Après, sans fichier sous les yeux, on pourra pas t'aider plus..

  3. #3
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Juillet 2014
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Meurthe et Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2014
    Messages : 4
    Points : 4
    Points
    4
    Par défaut
    Je viens de me rendre compte que j'ai posté deux fois le même message par erreur du coup j'ai remis les explications de mon autre message

    Bonjour à toutes et à tous,
    Je vous contacte car je suis novice en VBA et je n’arrive pas à solutionner mon problème. (De plus je ne suis pas l'auteur du code)

    J’ai un fichier Excel « Calcul » qui me permet d’extraire d’un autre fichier « Stock » des références d’articles avec des quantités, la macro extrait les données brutes du fichier stock où les références peuvent être répété plusieurs fois et fait un TCD sur le fichier Excel « Calcul » pour listé les références et sommer les quantités.
    J’ai voulu utiliser ce fichier Calcul pour une autre catégorie d’article, avec donc un autre fichier Excel « Stock2 » qui est exactement de la même forme que le premier (seules les infos dans les cellules et le nombre de lignes changent). Et là je rencontre une erreur.
    Erreur d’exécution ‘1004’
    Cette commande requiert au moins deux lignes de données sources. Vous ne pouvez pas l’utiliser sur une seule ligne de données. Essayez la méthode suivante :
    Si vous utilisez un filtre avancé, sélectionnez une plage de cellules qui contient au moins deux lignes de données. Puis cliquez à nouveau sur la commande Filtre élaboré
    Continuer Fin Débogage Aide
    Voici le début du code de la macro ;
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    Sub STOCK()
    
    'Enlève la protection de la feuille
    'Sheets("STOCK").Unprotect
    
    'Permet de faire une nouvelle acquisition du stock, supprime la feuille STOCK si elle existe déjà
        Application.DisplayAlerts = False
            For Each X In Sheets
                If X.Name = "STOCK" Then X.Unprotect
            Next
            For Each X In Sheets
                If X.Name = "STOCK" Then X.Delete
            Next
        Application.DisplayAlerts = True
        Dim dernière_ligne As Integer
    
    ' Dernière ligne de la base stock
        Workbooks.Open Filename:= _
            "U:\\STOCK MARO.xlsx"
        Windows("STOCK MARO.xlsx").Activate
        derniere_ligne = Sheets("Données").Range("A1").End(xlDown).Row
        
    ' Enregistrement du tableau
        Dim tab_stock()
        Dim ligne As Integer
        ReDim tab_stock(derniere_ligne - 2, 4)
    
        Windows("STOCK MARO.xlsx").Activate
        ligne = 0
        
            For i = 2 To derniere_ligne
            Vemp = Left(Sheets("Données").Range("F" & i), 1)
                If Vemp = 1 Then
                    tab_stock(ligne, 0) = Sheets("Données").Range("B" & i)
                    tab_stock(ligne, 1) = Sheets("Données").Range("F" & i)
                    tab_stock(ligne, 2) = Sheets("Données").Range("CM" & i)
                    tab_stock(ligne, 3) = Sheets("Données").Range("CX" & i)
                    ligne = ligne + 1
                End If
            Next
        Workbooks("STOCK MARO.xlsx").Close SaveChanges:=False
        
    'Affichage tableau dans excel
        Sheets.Add(Sheets(Sheets.Count)).Name = "PREV"
        Sheets.Add(Sheets(Sheets.Count)).Name = "TEMP"
        
            For ligne = 2 To UBound(tab_stock)
                Windows("Calcul.xlsm").Activate
                Sheets("PREV").Range("A1") = "SKU"
                Sheets("PREV").Range("A" & ligne) = tab_stock(ligne - 2, 0)
                'Sheets("PREV").Range("B1") = "EMPLACEMENT"
                'Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 1)
                Sheets("PREV").Range("B1") = "QUANTITE"
                Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 2)
                'Sheets("PREV").Range("D1") = "QUALITE"
                'Sheets("PREV").Range("D" & ligne) = tab_stock(ligne - 2, 3)
            Next
            
        ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        [PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
        TableDestination:="TEMP!R1C1", _
        TableName:="MonStock"    
            With Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU")
                .Orientation = xlRowField
                .Position = 1
            End With
        Worksheets("TEMP").PivotTables("MonStock").AddDataField Worksheets("TEMP").PivotTables( _
            "MonStock").PivotFields("QUANTITE"), "Sum of QUANTITE", xlSum
        Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU").AutoSort xlDescending, _
            "Sum of QUANTITE"
    J'ai mis en rouge la partie où l'erreur est détéctée.

    En éspérant avoir été clair et que quelqu'un pourra m'aider, je vous remercie d'avance.

    Bonne journée à toutes et à tous

    Jimmy G.


    PS: je n'arrive pas à mettre les fichiers en pièces jointes (Fichier non valide - alors que c'est un .xlsm)

  4. #4
    Membre chevronné
    Avatar de NVCfrm
    Homme Profil pro
    Administrateur Système/Réseaux - Developpeur - Consultant
    Inscrit en
    Décembre 2012
    Messages
    1 036
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations professionnelles :
    Activité : Administrateur Système/Réseaux - Developpeur - Consultant
    Secteur : High Tech - Produits et services télécom et Internet

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 036
    Points : 1 917
    Points
    1 917
    Billets dans le blog
    5
    Par défaut
    bonjour,

    ThisWorkbook.PivotCaches.Add
    n'existe pas.
    La methode Add s'applique plutôt à l'objet PivotTables de WorkSheet.
    Essaies.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    ThisWorkbook.PivotCaches.Create

  5. #5
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Juillet 2014
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Meurthe et Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2014
    Messages : 4
    Points : 4
    Points
    4
    Par défaut
    Merci pour vos réponses mais j'ai essayé de modifier Add -> Create et ça ne fonctionne pas, le pas à pas de la macro ne m'aide pas non plus.

    Je ne vois pas quel est le problème.
    Si cela peut aider quelqu'un à trouver une solution voila les fichiers.


    STOCK MARO.xlsx

    J'ai mis en pièce jointe mon fichier "stock" et j'ai mis le code du deuxième fichier; le fichier "Calcul" ci dessous parce que je ne peux pas insérer de pièce jointe en .xlsm

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    Sub STOCK()
     
    'Enlève la protection de la feuille
     
    'Sheets("STOCK").Unprotect
     
    'Permet de faire une nouvelle acquisition du stock, supprime la feuille STOCK si elle existe déjà
        Application.DisplayAlerts = False
            For Each X In Sheets
                If X.Name = "STOCK" Then X.Unprotect
            Next
            For Each X In Sheets
                If X.Name = "STOCK" Then X.Delete
            Next
        Application.DisplayAlerts = True
        Dim dernière_ligne As Integer
     
    ' Dernière ligne de la base stock
        Workbooks.Open Filename:= _
            "U:\STOCK MARO.xlsx"
        Windows("STOCK MARO.xlsx").Activate
        derniere_ligne = Sheets("Données").Range("A1").End(xlDown).Row
     
    ' Enregistrement du tableau
        Dim tab_stock()
        Dim ligne As Integer
        ReDim tab_stock(derniere_ligne - 2, 4)
     
        Windows("STOCK MARO.xlsx").Activate
        ligne = 0
     
            For i = 2 To derniere_ligne
            Vemp = Left(Sheets("Données").Range("F" & i), 1)
                If Vemp = 1 Then
                    tab_stock(ligne, 0) = Sheets("Données").Range("B" & i)
                    tab_stock(ligne, 1) = Sheets("Données").Range("F" & i)
                    tab_stock(ligne, 2) = Sheets("Données").Range("CM" & i)
                    tab_stock(ligne, 3) = Sheets("Données").Range("CX" & i)
                    ligne = ligne + 1
                End If
            Next
        Workbooks("STOCK MARO.xlsx").Close SaveChanges:=False
     
    'Affichage tableau dans excel
        Sheets.Add(Sheets(Sheets.Count)).Name = "PREV"
        Sheets.Add(Sheets(Sheets.Count)).Name = "TEMP"
     
            For ligne = 2 To UBound(tab_stock)
                Windows("Calcul.xlsm").Activate
                Sheets("PREV").Range("A1") = "SKU"
                Sheets("PREV").Range("A" & ligne) = tab_stock(ligne - 2, 0)
                'Sheets("PREV").Range("B1") = "EMPLACEMENT"
                'Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 1)
                Sheets("PREV").Range("B1") = "QUANTITE"
                Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 2)
                'Sheets("PREV").Range("D1") = "QUALITE"
                'Sheets("PREV").Range("D" & ligne) = tab_stock(ligne - 2, 3)
            Next
     
        ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        [PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
        TableDestination:="TEMP!R1C1", _
        TableName:="MonStock"
     
            With Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU")
                .Orientation = xlRowField
                .Position = 1
            End With
        Worksheets("TEMP").PivotTables("MonStock").AddDataField Worksheets("TEMP").PivotTables( _
            "MonStock").PivotFields("QUANTITE"), "Sum of QUANTITE", xlSum
        Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU").AutoSort xlDescending, _
            "Sum of QUANTITE"
     
    ' Mise à jour tabstock
        Erase tab_stock()
        Dim dligne_TCD As Integer
        dligne_TCD = Sheets("TEMP").Range("A1").End(xlDown).Row
        ReDim tab_stock(dligne_TCD - 2, 3)
     
            For i = 3 To dligne_TCD - 1
                Pos = 0
                Pos = InStr(1, Sheets("TEMP").Range("A" & i), " ", 0) 'trouve la position de " "
                tab_stock(i - 3, 0) = Left(Sheets("TEMP").Range("A" & i), Pos - 1) ' enregistre uniquement le SKU
                tab_stock(i - 3, 1) = Sheets("TEMP").Range("B" & i) ' enregistre la quantité
            Next
     
    'Nettoyage classeur
        Application.DisplayAlerts = False
        Worksheets("PREV").Delete
        Worksheets("TEMP").Delete
        Application.DisplayAlerts = True
     
    'Affichage EXCEL
        Sheets.Add(Sheets(Sheets.Count)).Name = "STOCK"
        Sheets("STOCK").Move After:=Sheets(2)
     
            For ligne = 2 To UBound(tab_stock)
                Sheets("STOCK").Range("A1") = "SKU"
                Sheets("STOCK").Range("A" & ligne) = tab_stock(ligne - 2, 0)
                Sheets("STOCK").Range("B1") = "QUANTITE"
                Sheets("STOCK").Range("B" & ligne) = tab_stock(ligne - 2, 1)
            Next
     
    'Mettre en forme le tableau et figer la première ligne
        Rows("1:1").RowHeight = 60
        Range("A1:B1").Select
        Selection.Font.Bold = True
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        Range("B1").Select
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
            End With
        ActiveWindow.FreezePanes = True
        Columns("A:A").ColumnWidth = 20
       ' Range("A1:B1").Select
       ' Selection.AutoFilter
     
     
    'Création du bouton retour à la page d'acceuil
        ActiveSheet.Buttons.Add(200, 10, 250, 40).Select
        ActiveSheet.Shapes.Range(Array("Button 1")).Select
        Selection.Characters.Text = "Revenir à la première page"
            With Selection.Characters(Start:=1, Length:=26).Font
                .Name = "Calibri"
                .FontStyle = "Gras"
                .Size = 17
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = True
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 3
                Selection.OnAction = "Accueil"
                ActiveWindow.Panes(3).Activate
                Range("A2").Select
            End With
     
    'Protège lA feuille STOCK
        Sheets("STOCK").Protect
     
    End Sub
    Merci d'avance

  6. #6
    Membre habitué
    Homme Profil pro
    Chargé d'Ingénierie et d'Analyses en Ressources Humaines
    Inscrit en
    Novembre 2012
    Messages
    63
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Chargé d'Ingénierie et d'Analyses en Ressources Humaines
    Secteur : Industrie

    Informations forums :
    Inscription : Novembre 2012
    Messages : 63
    Points : 169
    Points
    169
    Par défaut
    Bonjour,

    Comme le disait Illight, l'erreur est provoquée parce que tu n'as aucune donnée dans la zone définie comme source de ton TCD.

    Cette partie du code, qui génère l'erreur, fait référence à deux en-têtes de colonne de ta feuille "PREV" ce qui n'est pas suffisant pour créer un TCD :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    [PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
    TableDestination:="TEMP!R1C1", _
    TableName:="MonStock"
    Pour que ton code fonctionne il faut modifier la ligne suivante :
    Comme ceci :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If Vemp = 1 or Vemp = 3 Then
    Ici, tu test si le premier caractère de la cellule de la colonne F est égal à 1 ou 3 et non pas seulement à 1.
    Dans le fichier que tu fournis, aucune référence ne commence par 1 notamment parce que ça doit être une différence entre tes catégories d'articles :
    J’ai voulu utiliser ce fichier Calcul pour une autre catégorie d’article
    Voici ton code modifié :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    Sub STOCK()
     
    'Enlève la protection de la feuille
     
    'Sheets("STOCK").Unprotect
     
    'Permet de faire une nouvelle acquisition du stock, supprime la feuille STOCK si elle existe déjà
    Application.DisplayAlerts = False
    For Each X In Sheets
    If X.Name = "STOCK" Then X.Unprotect
    Next
    For Each X In Sheets
    If X.Name = "STOCK" Then X.Delete
    Next
    Application.DisplayAlerts = True
    Dim dernière_ligne As Integer
     
    ' Dernière ligne de la base stock
    Workbooks.Open Filename:= _
    "U:\STOCK MARO.xlsx"
    Windows("STOCK MARO.xlsx").Activate
    derniere_ligne = Sheets("Données").Range("A1").End(xlDown).Row
     
    ' Enregistrement du tableau
    Dim tab_stock()
    Dim ligne As Integer
    ReDim tab_stock(derniere_ligne - 2, 4)
     
    Windows("STOCK MARO.xlsx").Activate
    ligne = 0
     
    For i = 2 To derniere_ligne
    vemp = Left(Sheets("Données").Range("F" & i), 1)
    If vemp = 1 Or vemp = 3 Then
    tab_stock(ligne, 0) = Sheets("Données").Range("B" & i)
    tab_stock(ligne, 1) = Sheets("Données").Range("F" & i)
    tab_stock(ligne, 2) = Sheets("Données").Range("CM" & i)
    tab_stock(ligne, 3) = Sheets("Données").Range("CX" & i)
    ligne = ligne + 1
    End If
    Next
    Workbooks("STOCK MARO.xlsx").Close SaveChanges:=False
     
    'Affichage tableau dans excel
    Sheets.Add(Sheets(Sheets.Count)).Name = "PREV"
    Sheets.Add(Sheets(Sheets.Count)).Name = "TEMP"
     
    For ligne = 2 To UBound(tab_stock)
    Windows("Calcul.xlsm").Activate
    Sheets("PREV").Range("A1") = "SKU"
    Sheets("PREV").Range("A" & ligne) = tab_stock(ligne - 2, 0)
    'Sheets("PREV").Range("B1") = "EMPLACEMENT"
    'Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 1)
    Sheets("PREV").Range("B1") = "QUANTITE"
    Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 2)
    'Sheets("PREV").Range("D1") = "QUALITE"
    'Sheets("PREV").Range("D" & ligne) = tab_stock(ligne - 2, 3)
    Next
     
    ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    [PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
    TableDestination:="TEMP!R1C1", _
    TableName:="MonStock"
     
    With Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU")
    .Orientation = xlRowField
    .Position = 1
    End With
    Worksheets("TEMP").PivotTables("MonStock").AddDataField Worksheets("TEMP").PivotTables( _
    "MonStock").PivotFields("QUANTITE"), "Sum of QUANTITE", xlSum
    Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU").AutoSort xlDescending, _
    "Sum of QUANTITE"
     
    ' Mise à jour tabstock
    Erase tab_stock()
    Dim dligne_TCD As Integer
    dligne_TCD = Sheets("TEMP").Range("A1").End(xlDown).Row
    ReDim tab_stock(dligne_TCD - 2, 3)
     
    For i = 3 To dligne_TCD - 1
    Pos = 0
    Pos = InStr(1, Sheets("TEMP").Range("A" & i), " ", 0) 'trouve la position de " "
    tab_stock(i - 3, 0) = Left(Sheets("TEMP").Range("A" & i), Pos - 1) ' enregistre uniquement le SKU
    tab_stock(i - 3, 1) = Sheets("TEMP").Range("B" & i) ' enregistre la quantité
    Next
     
    'Nettoyage classeur
    Application.DisplayAlerts = False
    Worksheets("PREV").Delete
    Worksheets("TEMP").Delete
    Application.DisplayAlerts = True
     
    'Affichage EXCEL
    Sheets.Add(Sheets(Sheets.Count)).Name = "STOCK"
    Sheets("STOCK").Move After:=Sheets(2)
     
    For ligne = 2 To UBound(tab_stock)
    Sheets("STOCK").Range("A1") = "SKU"
    Sheets("STOCK").Range("A" & ligne) = tab_stock(ligne - 2, 0)
    Sheets("STOCK").Range("B1") = "QUANTITE"
    Sheets("STOCK").Range("B" & ligne) = tab_stock(ligne - 2, 1)
    Next
     
    'Mettre en forme le tableau et figer la première ligne
    Rows("1:1").RowHeight = 60
    Range("A1:B1").Select
    Selection.Font.Bold = True
    With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Range("B1").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Columns("A:A").ColumnWidth = 20
    ' Range("A1:B1").Select
    ' Selection.AutoFilter
     
     
    'Création du bouton retour à la page d'acceuil
    ActiveSheet.Buttons.Add(200, 10, 250, 40).Select
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.Characters.Text = "Revenir à la première page"
    With Selection.Characters(Start:=1, Length:=26).Font
    .Name = "Calibri"
    .FontStyle = "Gras"
    .Size = 17
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = True
    .Underline = xlUnderlineStyleNone
    .ColorIndex = 3
    Selection.OnAction = "Accueil"
    ActiveWindow.Panes(3).Activate
    Range("A2").Select
    End With
     
    'Protège lA feuille STOCK
    Sheets("STOCK").Protect
     
    End Sub
    Chtik

  7. #7
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Juillet 2014
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Meurthe et Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Industrie

    Informations forums :
    Inscription : Juillet 2014
    Messages : 4
    Points : 4
    Points
    4
    Par défaut
    Bonjour à tous,

    merci beaucoup pour vos réponses, cela fonctionne à présent.

    J'en profite pour demander un autre conseil étant donné l'efficacité du forum, dans le code
    If Vemp = 1 or Vemp = 3 Then
    Si je souhaite au contraire exclure des données qui commence par un Q ou un C

    Comment dois-je écrire mon code ?

    j'ai essayé ce code mais ca ne fonctionne
    If Vemp <> "Q" or Vemp <> "C" Then
    C'était une question bonus, je vais bien entendu signaler que le post est résolu

    Bonne journée à tous

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. remplissage zone de liste (Combobox) : Erreur d'exécution 1004 !?
    Par ln0331 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 05/02/2008, 17h02
  2. Réponses: 13
    Dernier message: 29/06/2007, 18h03
  3. Erreur d'exécution '1004' lors d'une mise en page
    Par alex.a dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 01/06/2007, 09h00
  4. [VBA-E] Erreur d'exécution '1004'
    Par bibi5883 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 13/03/2007, 14h31
  5. [VBA-E] erreur d'exécution 1004 ?
    Par toy dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 24/05/2006, 13h15

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo