Récupération de données suivant liste

Bonjour le Forum,

J'essaye de développer un fichier pour répertorier et affecter des références de procédures qui sont diffusées en pdf dans notre atelier.

La feuille répertoire, permet d'enregistrer de nouvelles procédures, sur la partie droite, on affecte la procédure à des services et / ou des postes. Il suffirait à l'utilisateur de renseigner un " 1 " dans les colonnes des postes concernées.

Pour que le fichier puisse durée, j'ai créer des feuilles " Poste_SJ1", "Poste_SJ2"; "PosteSTR"; "Service", ou l'on pourra renseigner le nom des lignes de productions (SJ1_C1;C2;C3;etc) et des postes sur chaqu'une des lignes (SJ1_C1_L1; SJ1_C1_L2;etc).

Sur la feuille répertoire, les colonnes d'affectations font références à ces postes.

Maintenant, je voudrais créer une interface (feuille Impression_SJ1;SJ2;STR;Service, pour permettre à l'utilisateur d'exporter la référence et la désignation de toutes les procédures affectées au poste choisi.

Pour choisir le poste j'ai créer des listes déroulantes, et lier les lignes de productions aux postes (formule indirect).

Est-ce Viable ?

Faut-il passer par une macro pour exporter la colonne M et N dans cette interface, en filtrant la colonne qui correspond au choix de l'utilisateur ? Comment doit-elle s'écrire ?

Voir le fichier

Merci de vos commentaires.

11repertoire.xlsm (147.61 Ko)

bonjour

faire simple (donc fiable, même si ça a l'air moins joli) : tu mets un filtre sur la liste. Terminé.

à la rigueur tu crées un pdf pour chacun

en 3 minutes tu fais tes mises à jour documentaires.

pas de "report d'information sur des feuilles supplémentaire"

ça perd du temps, et c'est pas fiable. Et faut recommencer si l'organisation change.

usine à gaz pour les gars.

SI j'ai bien compris, les utilisateurs devront filtrer eux mème la colonne qu'ils veulent ?

Je voudrais faire en sort que la macro copier les lignes sur 2 colonnes suivant un filtre = 1 sur la bonne colonne (choix liste déroulante).

J'ai essayer de récupérer un code, mais je ne comprend pas pourquoi cela ne fonctionne pas.

Sub Impression_Service()

Dim Compteur As Integer, Nom As String
    Application.DisplayAlerts = False
    For Compteur = Worksheets.Count To 1 Step -1
        Nom = Sheets(Compteur).Name
        Select Case Nom
        Case "Répertoire", "Impression par Service", "Liste_Référence", "Impression_SJ1", "Poste_SJ1", "Poste_SJ2", "Poste_STR", "Service", "Impression_SJ2", "Impression_STR"

        Case Else
            Sheets(Compteur).Delete
        End Select
    Next Compteur
    Application.DisplayAlerts = True

  Dim c_Services As String, intc_ColonneService As Integer
  Dim oSheetReport As Worksheet, oSheetRepertoire As Worksheet
  Dim aData() As String, i As Integer
  Dim rngReport As Range

  Set oSheetReport = Sheets("Impression par Service")
  Set oSheetRepertoire = Sheets("Répertoire")

  c_Services = oSheetReport.Range("c_SelectionService").Value
  intServiceCol = Evaluate(Names("c_ColonneService").Value)

  oSheetRepertoire.Select
  ReDim aData(Cells(65536, 1).End(xlUp).Row - 18, 2)
  i = 0
  Cells(Names("FirstLine_Répertoire").RefersToRange.Row + 1, 13).Select
  Do While Not IsEmpty(ActiveCell.Value)
    If ActiveCell.Offset(0, intServiceCol + 9).Value = 1 Then
      aData(i, 1) = ActiveCell.Value
      aData(i, 2) = ActiveCell.Offset(0, 1).Value
      aData(i, 3) = ActiveCell.Offset(0, 2).Value
      i = i + 1
    End If
    ActiveCell.Offset(1, 0).Select
  Loop
  oSheetReport.Select
  Range(Cells(Names("Report_FirstLine_Service").RefersToRange.Row, 2), Cells(150, 3)).ClearContents
  For i = 0 To UBound(aData)
    If aData(i, 1) = "" Then Exit For
    oSheetReport.Cells(Names("Report_FirstLine_Service").RefersToRange.Row + i, 2).Value = aData(i, 1)
    oSheetReport.Cells(Names("Report_FirstLine_Service").RefersToRange.Row + i, 3).Value = aData(i, 2)
  Next

  Set rngReport = oSheetReport.Range(Names("RNGReport_Service").RefersTo)
  ' test si la feuille existe, alors on va l'activer pour mise à jour au lieu de la créer
  If ExistSheet(c_Services) = True Then
    Sheets(c_Services).Select
    Range(Cells(2, 2), Cells(100, 6)).Clear
  Else
    Sheets.Add Before:=Sheets(1)
    ActiveSheet.Name = c_Services
  End If
  Cells(2, 2).Select
  rngReport.Copy
  ActiveCell.PasteSpecial
  Columns("B:D").ColumnWidth = 30
  Set oSheetReport = Nothing
  Set oSheetRepertoire = Nothing
  Set rngReport = Nothing
End Sub
9repertoire.xlsm (156.61 Ko)
Rechercher des sujets similaires à "recuperation donnees suivant liste"