Extraire des Données d'une base à partir d'un critère avec UserForm

Bonjour, je reviens vers vous car j'ai un petit problème avec un programme sur un UserForm. Je voudrais en fait que quand je sélectionne dans ma ComboBox (rattacher à une liste dans ma feuil3) un NOM de Stock, et que j'appuie sur Extraire, il me prend les produits avec toutes les infos et les met sur une nouvel feuille Excel. Pour l'instant il m'extrait que l'entête du tableau… .

Je vous joins le fichier Excel en pièce joint. Merci pour votre aide.

Cordialement.

Bonjour minakashi, le forum,

A tester:

Private Sub btnExtraction_Click()

   'Déclaration des Variables
   Dim tablo, tabloR(), titres
   Dim I%, k%, Nom As String

   'Affectation des variables
   tablo = Sheets("BaseDeDonnées").ListObjects("TStock2022").DataBodyRange
   titres = Sheets("BaseDeDonnées").Range("A6:J6")
    k = 0
    For I = 1 To UBound(tablo, 1)
        If UCase(tablo(I, 10)) = UCase(Me.CbxNomStock.Value) Then
            ReDim Preserve tabloR(1 To 10, 1 To k + 1)
            For j = 1 To 10
                tabloR(j, 1 + k) = tablo(I, j)
            Next j
            k = 1 + k
        End If
    Next I

    On Error Resume Next
   If k > 0 Then
    Nom = "Stock " & Me.CbxNomStock.Value
     Application.DisplayAlerts = False
      If WsExist(Sheets(Nom)) Then Sheets(Nom).Delete
     Application.DisplayAlerts = True
      Sheets.Add
       With ActiveSheet
       .Name = Nom
       .Range("A1").Resize(1, 10) = titres: .Range("A1").Resize(1, 10).Interior.ColorIndex = 6: .Range("A1").Resize(1, 10).Font.Bold = True
       .Range("A2").Resize(UBound(tabloR, 2), 10) = Application.Transpose(tabloR)
       .Columns.AutoFit
       End With
       MsgBox "Extraction effectuée"
   Else
       MsgBox "Aucunes données à extraire"
   End If
End Sub

Dans un module standard:

Function WsExist(Nom$) As Boolean  'test si la feuille existe déjà
   On Error Resume Next
   WsExist = Worksheets(Nom).Index
End Function

Cordialement,

Gros merci xorsankukai je penser pas devoir ajouter autant de code, merci. Vous pourriez juste svp y mettre quelques explications dans le programme? je ne comprends pas trop comment vous avez fait haha , merci encore.

Cordialement.

Re,

Merci pour ton retour,

Private Sub btnExtraction_Click()

   'Déclaration des Variables
   Dim tablo, tabloR(), titres
   Dim I%, k%, Nom As String

   'Affectation des variables
   tablo = Sheets("BaseDeDonnées").ListObjects("TStock2022").DataBodyRange 'définit le tableau de données
   titres = Sheets("BaseDeDonnées").Range("A6:J6") '........................ligne de titres
    k = 0 '.................................................................index de ligne du tableau temporaire
    For I = 1 To UBound(tablo, 1) '.........................................boucle sur toutes les lignes de tablo
        If UCase(tablo(I, 10)) = UCase(Me.CbxNomStock.Value) Then '.........si colonne 10= valeur combobox
            ReDim Preserve tabloR(1 To 10, 1 To k + 1) '....................on dimensionne le tableau temporaire tabloR
            For j = 1 To 10
                tabloR(j, 1 + k) = tablo(I, j) '............................écrit les données dans tabloR
            Next j
            k = 1 + k '.....................................................passe à la ligne suivante
        End If
    Next I

    On Error Resume Next
   If k > 0 Then '..........................................................si tabloR contient des données
    Nom = "Stock " & Me.CbxNomStock.Value '.................................définit le nom de la feuille à créer
     Application.DisplayAlerts = False '....................................désactive message d'alerte
      If WsExist(Sheets(Nom)) Then Sheets(Nom).Delete '.....................si la feuille existe déjà, on la supprime (fonction personnalisée)
     Application.DisplayAlerts = True '.....................................rétablit les messages d'alerte
      Sheets.Add '..........................................................ajoute une feuille
       With ActiveSheet '...................................................sur la feuille créée
       .Name = Nom '........................................................définit le nom de la feuille
       'Copie les titres sur fond jaune avec police en gras
       .Range("A1").Resize(1, 10) = titres: .Range("A1").Resize(1, 10).Interior.ColorIndex = 6: .Range("A1").Resize(1, 10).Font.Bold = True
       .Range("A2").Resize(UBound(tabloR, 2), 10) = Application.Transpose(tabloR) '..écrit les données de tabloR en dur sur la feuille
       .Columns.AutoFit '....................................................ajuste la largeur des colonnes
       End With
       MsgBox "Extraction effectuée" '.......................................message de confirmation (facultatif)
   Else
       MsgBox "Aucunes données à extraire" '..................................message si aucune donnée (facultatif)
   End If
End Sub

En espérant que cela t'aide,

Cordialement,

Merci! je vais pouvoir essayer de comprendre comment tu a fais . Passe une bonne soirée.

Cordialement