XL 2010 ramener des occurrences dans une feuille

denisR

XLDnaute Nouveau
bonjour à tous

J'ai cherché un peu sur internet mais je n'ai pas trouvé de résultats peut ter parce que je formule mal ma question
Je cherche un morceau de code vba pour me ramener sur une feuille des données d'une autre feuille
je m'explique
en colonne 1 j'ai le dossier
en colonne 2 j'ai la reference
je peux avoir plusieurs références pour un meme dossier
J'ai besoin dans une feuille adjacente de retrouver en ligne 1 le numero de dossier
et en ligne 2 dans chaque colonne chaque reference
je precise que le nb de ref par dossier peut varier et qu'un ensemble dossier/ref n'existe q'une seule fois

je joins un fichier excel pour exemple
en feuille 1 les donnees
en feuille 2 le resultat attendu pour le premier dossier
en feuille3 le second dossier etc...

en fait je n'arrive pas à trouver un code qui cherche les differentes occurences par dossier et qui me les ramene dans une feuille

Merci pour votre aide
 

Pièces jointes

  • Classeur1.xlsx
    9.1 KB · Affichages: 25

Theze

XLDnaute Occasionnel
Bonjour,

Tu supprimes toutes tes feuilles sauf la feuille "Feuil1" où se trouve ton tableau à dispatsher puis tu colle ce code dans un module standard et tu l'exécutes . Les feuilles sont créées automatiquement :
Code:
Sub Test()
   
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Col As Long
   
    'défini la plage en colonne B de la feuille "Feuil1" à partir de B4
    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(4, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
   
    'gèle
    Application.ScreenUpdating = False
   
    'parcours la plage...
    For Each Cel In Plage
       
        'les feuilles sont ajoutées au fur et à mesure des différents dossiers et elles portent le nom "Dossier " et le nom du dossier en colonne B
        'une erreur est générée si la feuille n'existe pas donc, création de la feuille et nommage avec paramétrage des cellules A5 et A6
        On Error Resume Next
        Set Fe = Worksheets("Dossier " & Cel.Value)
       
        If Err.Number <> 0 Then
       
            Set Fe = Worksheets.Add(, Sheets(Sheets.Count))
            Fe.Name = "Dossier " & Cel.Value
           
            Fe.Range("A5").Value = "Dossier"
            Fe.Range("A6").Value = "Ref"
           
            On Error GoTo 0
           
        End If
       
        'inscription des valeurs les unes à la suite des autres
        With Fe: Col = .Cells(5, .Columns.Count).End(xlToLeft).Column + 1: End With 'sur ligne 5
        Fe.Cells(5, Col).Value = Cel.Value
        Fe.Cells(6, Col).Value = Cel.Offset(, 1).Value
       
    Next Cel
   
    'rafraîchi
    Application.ScreenUpdating = True
   
End Sub
 

denisR

XLDnaute Nouveau
inscription des valeurs les unes à la suite des autres
With Fe: Col = .Cells(5, .Columns.Count).End(xlToLeft).Column + 1: End With 'sur ligne 5
Fe.Cells(5, Col).Value = Cel.Value
Fe.Cells(6, Col).Value = Cel.Offset(, 1).Value


merci beaucoup pour la réponse rapide
les feuilles elles sont déjà créées par un code que je n'ai pas joint car assez long
je teste les instructions ci dessus en les adaptant et je reviens
 

denisR

XLDnaute Nouveau
merci THEZE
j'ai adapté le code et j'ai encore un probleme
en fait les donnees que je veux ramener sont dans des colonnes non adjacentes
colonne B et colonne D par exemple avec des colonnes entre
la syntaxe ne doit pas etre bonne car quand je defini la plage il ramene toutes les colonnes
de la 4 à la 11
Set Plage = .Range(.Cells(3, 4), .Cells(.Rows.Count, 11).End(xlUp))

un tuyau

encore merci
 

Theze

XLDnaute Occasionnel
Re,

Cette ligne de code ne doit pas changer :
Code:
With Worksheets("Feuil1"): Set Plage = .Range(.Cells(4, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
si tes noms de dossiers sont dans la colonne B à partir de B4 par contre, il te faut modifier les Offset() par rapport à cette colonne (la colonne B)
La ligne ci-dessous retourne la valeur en colonne C :
Code:
Fe.Cells(6, Col).Value = Cel.Offset(, 1).Value
si tu veux la colonne D, tu remplace le 1 par 2 donc, de cette façon :
Code:
Fe.Cells(6, Col).Value = Cel.Offset(, 2).Value
 

denisR

XLDnaute Nouveau
elementaire mon cher watson
mais je ne sais si je peux abuser de ta patience
en fait le code fonctionne bien et me balaie tout ce que j'ai en colonne B
En fait ce que je voudrai c'est avec un numero de dossier memorisé en variable aller chercher uniquement les lignes referentes à ce dossier

ne faut il pas que j'ajoute un find à cette premiere ligne de code

With Worksheets("Feuil1"): Set Plage = .Range(.b:b).find(numdossier))

merci d'avance
 

denisR

XLDnaute Nouveau
bonjour

Ce n'est certainement pas un code optimisé mais finalement j'ai le résultat escompté avec le code ci dessous
Sub formulespardossierref()

Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Col As Long
Dim c As Object
Dim therow As Integer
Dim numdossier As Integer
Dim nomdossier As Variant
Dim nbrcol As Integer
Dim dossierencours As Integer

'Affectation des valeurs aux variables
Sheets("menu").Select
dossiermini = Range("J2").Value
dossiermaxi = Range("K2").Value
nbrcol = Range("J3").Value
nomdossier = Worksheets("MENU").Range("F4").Value & "-" & Format(dossierencours, "000")
Sheets("Menu").Range("J4").Value = dossierencours 'affecte le numero de dossier en cours à la cellule Z4 pour verifier qu'il existe



'tri onglet data sur DFND et ARTFAB
ActiveWorkbook.Worksheets("Data").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Accès_à_la_base_AS400").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Data").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Accès_à_la_base_AS400").Sort.SortFields. _
Add Key:=Range( _
"Tableau_Lancer_la_requête_à_partir_de_Accès_à_la_base_AS400[DFND]"), SortOn _
:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Accès_à_la_base_AS400").Sort.SortFields. _
Add Key:=Range( _
"Tableau_Lancer_la_requête_à_partir_de_Accès_à_la_base_AS400[ART_FAB]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Data").ListObjects( _
"Tableau_Lancer_la_requête_à_partir_de_Accès_à_la_base_AS400").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'recherche premier numero de ligne du dossier
numdossier = dossiermini
therow = Sheets("data").Columns(4).Cells.Find(What:=numdossier, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
Col = 1

'défini la plage colonne D à K de la feuille "data" à partir du dossier 1
With Worksheets("data")
Set Plage = .Range(.Cells(therow, 4), .Cells(.Rows.Count, 4).End(xlUp))
End With
Set Fe = Worksheets(nomdossier)

'parcours la plage...
For Each Cel In Plage

If Col > nbrcol Then
'inscription des valeurs les unes à la suite des autres
GoTo sortieboucle
End If
Fe.Cells(12, Col + 1).Value = Cel.Offset(, 7).Value
Col = Col + 1

Next Cel
: sortieboucle

End Sub


Merci pour ton aide qui m'a permis d'avancer
 

Discussions similaires