Feuilles non prises en compte dans macro Résolu

Question

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


Configuration: Mac OS X Lion (10.7.5) / Chrome 28.0.1500.71

Gyrus · Answer

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+

f894009 · Answer

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

cha74 · Answer

ça marche :) Merci beaucoup à tous les deux! 

(Gyrus : en effet il fallait renseigner cette colonne)

Charlotte

foo · Answer

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

Feuilles non prises en compte dans macro

4 réponses

Discussions similaires

Newsletters