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.
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