problème avec un classeur de 300 onglets!

[monta0mac]

Bonjour à tous

Je suis sur le projet d'un inventaire dans mon boulot et je travaille sur un fichier qui contient 300 onglets.
en effet chaque onglet correspond à une fiche de stock d'un article.
Ce que je désire faire:
prendre de chaque onglet le code article et la désignation de l'article et les mettre dans un tableau "inventaire" pour qu'on puisse faire un inventaire physique.

pouvez vous svp m'aidez?

Merci par avance

 

[DoubleZero]

Re : problème avec un classeur de 300 onglets!

Bonjour à toutes et à tous,

Bienvenue sur XLD, monta0mac !

Peut-être ainsi :

Option Explicit
Sub Inventaire()
Dim o As Worksheet
For Each o In Worksheets
    If o.Name <> "Inventaire" Then
        Range("a" & Rows.Count).End(xlUp).Offset(1, 0) = o.Range("f5")
        Range("b" & Rows.Count).End(xlUp).Offset(1, 0) = o.Range("d5")
    End If
Next
End Sub

A bientôt 🙂

 

[monta0mac]

Re : problème avec un classeur de 300 onglets!

merci pour votre aide mais les article et les code article ne correspondent pas

 

[chris]

Re : problème avec un classeur de 300 onglets!

Bonjour
Bise à 00

merci pour votre aide mais les article et les code article ne correspondent pas

Sur ton exemple cela fonctionne parfaitement si tu lances la macro en étant sur la feuille inventaire.
Si tu veux pouvoir l'appeler de n'importe où dans le classeur, modifie ainsi

Option Explicit
Sub Inventaire()
Dim o As Worksheet
For Each o In Worksheets
    If o.Name <> "Inventaire" Then
        Worksheets("Inventaire").Range("a" & Rows.Count).End(xlUp).Offset(1, 0) = o.Range("f5")
        Worksheets("Inventaire").Range("b" & Rows.Count).End(xlUp).Offset(1, 0) = o.Range("d5")
    End If
Next
End Sub

 

[Staple1600]

Re : problème avec un classeur de 300 onglets!

Bonjour à tous

Pour le plaisir de croiser chris et 00 et aussi un peu pour honorer les endives 😉

Option Explicit
Sub Inventaire()
Dim o As Worksheet
For Each o In Worksheets
    If o.Name <> "Inventaire" Then
        With Worksheets("Inventaire").Range("a" & Rows.Count).End(xlUp)
            .Offset(1) = o.Range("F5")
            .Offset(1, 1) = o.Range("D5")
        End With 'ici est l'hommage ;o)
    End If
Next
End Sub

 

[Staple1600]

Re : problème avec un classeur de 300 onglets!

Re


Et celle-là c'est pour le fun et par pur désœuvrement pour cause de temps maussade 😉

Option Explicit
Sub Inventaire()
Dim o As Worksheet
For Each o In Worksheets
    If o.Name <> "Inventaire" Then
        With Worksheets("Inventaire").Range("a" & Rows.Count).End(xlUp)(2)
            .Value = o.[F5]: .Offset(, 1) = o.[D5]
        End With
    End If
Next
End Sub

 

[Efgé]

Re : problème avec un classeur de 300 onglets!

Bonjour monta0mac, Re Staple 🙂 , Bonjour chris 🙂, Bonjour 00 🙂

Juste pour faire parti de la joyeuse assemblée :

Sub inventaire()
Dim K&, TInvent As Variant, OSh As Worksheet
ReDim TInvent(1 To Sheets.Count - 1, 1 To 2)
K = 0


For Each OSh In Worksheets
    If OSh.Name <> "Inventaire" Then
        K = K + 1
        TInvent(K, 1) = OSh.Cells(5, 6)
        TInvent(K, 2) = OSh.Cells(5, 4)
    End If
Next OSh


With Sheets("Inventaire")
    .Cells(2, 1).Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    .Cells(2, 1).Resize(K, UBound(TInvent, 2)) = TInvent
End With


End Sub

Cordialement

 

[ChTi160]

Re : problème avec un classeur de 300 onglets!

Bonsoir monta0mac
Bonsoir le Fil
Bonsoir le Forum
Histoire de saluer une belle Brochette Lol d'ExcelNautes
une version non pas papier , mais tableau Lol

Option Explicit
Option Base 1
Dim x As Byte
Dim o As Worksheet
Dim Tab_Recap() As Variant
Dim DerLgn As Integer
Sub Inventaire()
x = 0
For Each o In Worksheets
If o.Name <> "Inventaire" Then
x = x + 1
ReDim Preserve Tab_Recap(2, x)
Tab_Recap(1, x) = o.Range("f5")
Tab_Recap(2, x) = o.Range("d5")
End If

Next
With Worksheets("Inventaire")
DerLgn = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(DerLgn, 1).Resize(UBound(Tab_Recap, 2), UBound(Tab_Recap, 1)) = Application.Transpose(Tab_Recap)
End With
Erase Tab_Recap
End Sub

Ps : pas Vu Efge
Bonne fin de Soirée
Amicalement
Jean marie

 

[mapomme]

Re : problème avec un classeur de 300 onglets!

Bonjour monta0mac, le fil, le forum,

Juste pour le fun (en un peu plus tordu!), avec tableaux et sans test de la feuille inventaire:

Sub Invent()
Dim T, V, i
  With Sheets("Inventaire")
    .Range("A2:B" & .Rows.Count).ClearContents
    i = .Index
    .Move After:=Sheets(Sheets.Count)
    ActiveWorkbook.Names.Add Name:="n_s", RefersToR1C1:="=GET.WORKBOOK(1)"
    T = Application.Evaluate("=n_s")
    .Move before:=Sheets(i)
    ReDim Preserve T(1 To UBound(T) - 1): ReDim V(1 To UBound(T))
    For i = 1 To UBound(T)
      V(i) = Sheets(Replace(T(i), "[" & ThisWorkbook.Name & "]", "")).Range("$F$5")
      T(i) = Sheets(Replace(T(i), "[" & ThisWorkbook.Name & "]", "")).Range("$D$5")
    Next i
    .Range("A2").Resize(UBound(V)) = Application.Transpose(V)
    .Range("B2").Resize(UBound(T)) = Application.Transpose(T)
  End With
End Sub