MATAMATA | Désoler de n'avoir pas étais assez clair, mais le nez dessus depuis deux semaine j'ai du mal à avoir un oeil subjectif 
Voila mon programme : ( même structure que précedente ) avec des modifications :
Option Explicit
Public Sub EXTRACTION(ByVal donnee)
Dim I As Integer
Dim J As Integer
Dim XI As Integer
Dim XJ As Integer
Dim XXJ As Integer
Dim XXI As Integer
Dim DETAIL As Integer
Dim NOM As String
Dim XCOLONNE As String
Dim XLIGNE As Integer
Dim Xchamps As Integer
Dim ENTITES As Object
Dim XXXJ As Integer
Dim NBfeuilles As Integer
Dim TABLE
Dim OK As Boolean
Dim XXXXJ As Integer
' *** EXTRACTION Suppression des feuilles Entité A,B ..... avant de relancer le programme
Application.DisplayAlerts = False
For XI = Worksheets.Count To 2 Step -1
If Left(Worksheets(XI).Name, 6) = "Entité" Then
Worksheets(XI).Delete
End If
Next XI
NBfeuilles = 0
' *** /EXTRACTION
XI = 4
XJ = 1
XXXJ = 0
XXXXJ = 1
I = 3
J = 3
XXJ = 3
XXI = 2
Sheets("Entités" ).Activate
While XJ <= 100
If Sheets("Entités" ).Cells(XI, XJ) <> "" Then
Sheets(5).Activate
Set ENTITES = ActiveWorkbook.Worksheets.Add
NOM = Left(Sheets("Entités" ).Cells(2, XJ), (Len(Sheets("Entités" ).Cells(2, XJ)) - 2))
ENTITES.Name = NOM
NBfeuilles = NBfeuilles + 1
Sheets(1).Activate
Sheets(1).Select
Cells(XI, XJ).Select
Selection.CurrentRegion.Select
Selection.Copy
ENTITES.Select
Range("A1" ).Select
ActiveSheet.Paste
Xchamps = 3
While Sheets("liste" ).Cells(Xchamps, 6) <> ""
Sheets("liste" ).Select
XCOLONNE = Cells(Xchamps, 6).Value
ENTITES.Activate
Cells(XXI, XXJ) = XCOLONNE
XXJ = XXJ + 1
Xchamps = Xchamps + 1
Wend
OK = True
While Workbooks(donnee).Sheets(1).Cells(1, XXXXJ) <> "" And OK = True
If Workbooks(donnee).Sheets(1).Cells(1, XXXXJ).Value = XCOLONNE Then
XXXJ = XXXXJ
OK = False
End If
XXXXJ = XXXXJ + 1
Wend
Sheets(NOM).Activate
While Cells(I, 1) <> ""
While Cells(2, J) <> ""
XLIGNE = Sheets(NOM).Cells(I, 1)
ActiveWindow.WindowState = xlMinimized
Cells.Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="TABLE", RefersToR1C1:="=PR99Y02!R1:R65536"
DETAIL = Application.WorksheetFunction.VLookup(XLIGNE, TABLE, XXXJ, False)
ActiveWindow.WindowState = xlNormal
Sheets(NOM).Select
Cells(I, J) = DETAIL
J = J + 1
Wend
J = 3
I = I + 1
Wend
End If
XJ = XJ + 4
Wend
Application.DisplayAlerts = True
End Sub
|
Exemple de la structure de ma feuille Entités : ( desoler j'ai pas reussit a l'agrandir, il faut cliquer dessus )
Pour ce qui est des feuilles, je ne me souviens plus pourauoi j'active la feuille 5 mais ca dois être pour l'utilisateur 
Ce programme marche partiellement, c'est a dire, qu'il creer pour chaque Entités ( liste de codegeo comme dans le deusieme quote de ce post ) un onglet, le seul probleme reside dans l'insertion de la fonction vlookup dans ces nouvelles feuilles ...... ici >>>
Citation :
While Cells(I, 1) <> ""
While Cells(2, J) <> ""
XLIGNE = Sheets(NOM).Cells(I, 1)
ActiveWindow.WindowState = xlMinimized
Cells.Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="TABLE", RefersToR1C1:="=PR99Y02!R1:R65536" je nomme la plage de donnée TABLE
DETAIL = Application.WorksheetFunction.VLookup(XLIGNE, TABLE, XXXJ, False) la syntaxe dois être mauvaise mais Xligne et XXXJ sont ont les valeurs souhaités
ActiveWindow.WindowState = xlNormal
Sheets(NOM).Select
Cells(I, J) = DETAIL
J = J + 1
Wend
J = 3
I = I + 1
Wend
|
j'ai essayer ici de nommer la plage TABLE, mais je ne dois pas avoir la bonne syntaxe pour que cela marche
Merci à tous 
|
