Sujet Précédent Sujet Suivant

Feuilles non prises en compte dans macro

Résolu/Fermé
cha74 Messages postés 9 Date d'inscription vendredi 12 juillet 2013 Statut Membre Dernière intervention 25 juillet 2013 - Modifié par cha74 le 25/07/2013 à 08:54
 foo - 25 juil. 2013 à 12:21
Bonjour,
j'ai posté un message sur ce forum il y a deux semaines et quelqu'un m'avait bien aidé en me créant une macro. Pour résumer, dans la feuille 1 j'ai un inventaire de stock de barres de plusieurs diamètres et la macro "affectertouslesdiam" permet que les lignes faisant référence à chaque diamètre apparaissent dans une feuille qui lui est propre.

Le problème c'est que je me suis rendu compte que cette macro ne marchait pas pour les diamètres supérieurs à 10. De plus j'ai rajouté une feuille inventaire et depuis ça ne fonctionne plus du tout (sauf si je la mets en dernier).
Voici mon fichier : https://www.cjoint.com/?0GziL4qIIb8
Est ce que quelqu'un pourrait m'expliquer ce qu'il faut faire s'il vous plait?

Merci d'avance pour votre aide,
Charlotte


A voir également:

4 réponses

Réponse 1 / 4
Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
25 juil. 2013 à 10:44
Bonjour,

Fais le test avec cette procédure adaptée 
Sub affectertouslesdiam()
Dim Nbre As Byte, Cptr As Byte
Dim T_diam(), Nb_diam As Integer
Dim Lig As Integer, Cptr_lig As Integer, T_out(), Feuille As String, Ligvid As Integer
    Application.ScreenUpdating = False
    'mémorise le nom des feuilles diamètres
    Nbre = Sheets.Count
    For Cptr = 3 To Nbre
        ReDim Preserve T_diam(1 To Nbre - 2)
        T_diam(Cptr - 2) = Mid(Sheets(Cptr).Name, 2, 9 ^ 9)
    Next
    For Cptr = 1 To UBound(T_diam)
        With Sheets("Feuil1")
            Nb_diam = Application.CountIf(.Columns("C"), T_diam(Cptr))
            If Nb_diam > 0 Then
                'recherche des diamètres de la feuille en cours
                Lig = 1
                For Cptr_lig = 1 To Nb_diam
                    Lig = .Columns("C").Find(T_diam(Cptr), .Cells(Lig, "C"), xlValues).Row
                    T_out = .Range(.Cells(Lig, "A"), .Cells(Lig, "J")).Value
                    Feuille = "f" & T_diam(Cptr)
                    'restitution dans la feuille diamètre en cours
                    With Sheets(Feuille)
                        Ligvid = .Columns("T").Find("", .Range("T2")).Row
                        .Range(.Cells(Ligvid, "T"), .Cells(Ligvid, "AB")) = T_out
                    End With
                Next
            End If
        End With
    Next
    MsgBox " Mise à jour terminée"
End Sub

A+
0
cha74 Messages postés 9 Date d'inscription vendredi 12 juillet 2013 Statut Membre Dernière intervention 25 juillet 2013
25 juil. 2013 à 11:09
Merci, maintenant j'ai bien quelque chose pour les diamètres supérieurs à 10. Par contre je n'ai plus qu'une ligne dans les tableaux des feuilles de diamètre :/ Or j'ai plusieurs lignes pour chaque diamètre dans la feuille 1
0
Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
25 juil. 2013 à 11:18
Assure-toi que la colonne Fournisseurs est bien renseignée.

A+
0
Réponse 2 / 4
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
25 juil. 2013 à 11:16
Bonjour,

ceci devrait aller: 

Sub affectertouslesdiam()
    Dim Nbre As Byte, Cptr As Byte
    Dim T_diam, Nb_diam As Integer
    Dim Lig As Integer, Cptr_lig As Integer, T_out(), Feuille As String * 6, Ligvid As Integer
    Dim sh As Worksheet

    Application.ScreenUpdating = False
    'Recherche dans les onglets fØ
    For Each sh In Worksheets
        'test onglets
        If sh.Name Like "fØ*" Then
            'Nom onglet-f
            T_diam = Mid(sh.Name, 2, Len(sh.Name) - 1)
            With Sheets("feuil1")
                Nb_diam = Application.CountIf(.Columns("C"), T_diam)
                If Nb_diam > 0 Then
                    'recherche des diametres de la feuille en cours
                    Lig = 1
                    For Cptr_lig = 1 To Nb_diam
                        Lig = .Columns("C").Find(T_diam, .Cells(Lig, "C"), xlValues).Row
                        T_out = .Range(.Cells(Lig, "A"), .Cells(Lig, "J")).Value
                        With Sheets(sh.Name)
                            Ligvid = .Columns("T").Find("", .Range("T2")).Row
                            .Range(.Cells(Ligvid, "T"), .Cells(Ligvid, "AB")) = T_out
                        End With
                    Next
                End If
            End With
        End If
    Next sh
    MsgBox " Mise à jour terminée"
End Sub
0
Réponse 3 / 4
cha74 Messages postés 9 Date d'inscription vendredi 12 juillet 2013 Statut Membre Dernière intervention 25 juillet 2013
25 juil. 2013 à 11:41
ça marche :) Merci beaucoup à tous les deux!

(Gyrus : en effet il fallait renseigner cette colonne)

Charlotte
0
Réponse 4 / 4
foo
25 juil. 2013 à 12:21
Bonjour

Ta recap est pas bonne
voila une macro de mise a jour des onglets

Sub ListOnglet()
For I = 1 To Worksheets.Count
Onglet = Worksheets(I).Name
Feuil2.Range("P" & I).Value = Worksheets(I).Name
Next I
End Sub

Sub MiseAjourVar()
NoLig = Feuil2.Range("P" & Rows.Count).End(xlUp).Row
For L = 3 To NoLig
Onglet = Feuil2.Range("P" & L).Value
Sheets(Onglet).Select
Nlig = Range("D" & Rows.Count).End(xlUp).Row
Range("F1").FormulaLocal = "=SOUS.TOTAL(9;F3:F" & Nlig & ")"
Range("H1").FormulaLocal = "=SOUS.TOTAL(9;H3:H" & Nlig & ")"
Range("J1").FormulaLocal = "=SOUS.TOTAL(9;J3:J" & Nlig & ")"
Range("Q1").FormulaLocal = "=SOUS.TOTAL(9;Q3:Q" & Nlig & ")"
Range("X1").FormulaLocal = "=SOUS.TOTAL(9;X3:X" & Nlig & ")"
Range("Z1").FormulaLocal = "=SOUS.TOTAL(9;Z3:Z" & Nlig & ")"
Range("A3").Select
Next
End Sub

Sub EffaceTab()
NoLig = Feuil2.Range("P" & Rows.Count).End(xlUp).Row
For L = 3 To NoLig
Onglet = Feuil2.Range("P" & L).Value
Sheets(Onglet).Range("T3:AC500").ClearContents
Next
End Sub

a toi de voir si ca te va

A+

Maurice
0