Remplir onglet avec fichier de base et 2 conditions

Grâce à Banzai64, j'ai pu avancer sur la personnalisation d'un code et maintenant je dois ramener de la donnée dans mes onglets créés.

J'ai un onglet "Index" et 2 onglets modèles "GAB_1" et "GAB_2".

Lorsque je lance ma Macro, autant de nouveaux onglets sont créés tant que j'ai de cellule en colonne A:A avec une gestion des doublons. Les nouveaux onglets sont nommés en fonction de la cellule prise en Index et en fonction du modèle pris

Maintenant, je dois ramener dans les 2 onglets créés de la donnée "data"(colonne I;I en fonction de la feuille "Index" et de "id_colonne" (colonne H:H) et "id_arbo" (colonne F:F).

C'est un peu comme une bataille navale quand j'ai id_colonne=2" et "id_arbo=2" de "index" je dois ramener le contenu "data" dans l'onglet créé au croisement concerné.

Pour le moment ma macro place les données dans la bonne colonne mais pas au bon croisement.

Merci à ceux qui pourront m'aider et bonjour à ceux qui me liront.

Sub Import_DATA()

Dim LigDep As Long
   Application.ScreenUpdating = False
   Set bd = Sheets("Index")
   bd.[A1].CurrentRegion.Sort Key1:=bd.Range("K2"), Order1:=xlAscending, _
   Key2:=bd.Range("H2"), Order2:=xlAscending, _
   Key3:=bd.Range("F2"), Order3:=xlAscending, Header:=xlGuess

   ligbd = 2
   Do While ligbd <= bd.[A65000].End(xlUp).Row
       id_rgp = bd.Cells(ligbd, 1)       ' Premier id_rgp

       Sheets("GAB_1").Copy After:=Sheets(Sheets.Count)
       ActiveSheet.Name = id_rgp & "_1"
       Set plan = Sheets(id_rgp & "_1")
       plan.Range("A1").Value = id_rgp
       ligPlan = 4

       LigDep = ligbd
       Do While bd.Cells(ligbd, 1) = id_rgp   'parcours  id_rgp traité
         id_arbo = bd.Cells(ligbd, 6)
         id_colonne = bd.Cells(ligbd, 8)
         Data = bd.Cells(ligbd, 10)
         Q = Application.Match(id_colonne, [CodesConges], 0)
         If Not IsError(Q) Then plan.Cells(ligPlan, Q + 2) = Data
         ligbd = ligbd + 1
         ligPlan = ligPlan + 1
      Loop

       Sheets("GAB_2").Copy After:=Sheets(Sheets.Count)
       ActiveSheet.Name = id_rgp & "_2"
      Set plan = Sheets(id_rgp & "_2")
       plan.Range("A1").Value = id_rgp
       ligPlan = 4

       ligbd = LigDep
       Do While bd.Cells(ligbd, 1) = id_rgp   'parcours  id_rgp traité
         id_arbo = bd.Cells(ligbd, 6)
         id_colonne = bd.Cells(ligbd, 8)
         Data = bd.Cells(ligbd, 10)
         Q = Application.Match(id_colonne, [CodesConges], 0)
         If Not IsError(Q) Then plan.Cells(ligPlan, Q + 2) = Data
         ligbd = ligbd + 1
         ligPlan = ligPlan + 1
       Loop
       Loop

'ThisWorkbook.Save
'Application.Quit
End Sub

Bonsoir

A vérifier

Encore merci à Banzai64. Tout marche à merveille, mais il y a un mais. J'ai une ultime et dernière étape avant de finaliser ce code.

Les onglets sont bien remplis en fonction des 2 conditions, mais je ne dois avoir en id_colonne que 6 colonnes et non 8 comme dans l'exemple précédent. Ce qui veut dire qu'il me faudrait avoir autant d'onglet par id_rgp et par multiple de 6 id_colonnes.

Exemple :

Pour id_rgp = 3477 j'ai 66 colonnes je devrais donc avoir 11 onglets en 3477_gp#_1 et 11 onglets 3477_gp#_2 (1 et 2 sont les gabarits,

# est le regroupement de 6 colonnes et les onglets doivent se suivre par modèle (GAB_1|GAB2). Cela donnerait :

3477_gpcol1_1 | 3477_gpcol1_2 |3477_gpcol2_1 |3477_gpcol2_2 | 3477_gpcol3_1 | 3477_gpcol3_3 | 3477_gpcol4_1 | 3477_gpcol4_2 | 3477_gpcol5_1| 3477_gpcol5_2 | 3477_gpcol6_1 | 3477_gpcol6_2 | 3477_gpcol7_1| | 3477_gpcol7_2 | 3477_gpcol8_1 | 3477_gpcol8_2 | 3477_gpcol9_1 | 3477_gpcol9_2 | 3477_gpcol10_1 | 3477_gpcol10_2| 3477_gpcol11_1 | 3477_gpcol11_2

Est ce que je dois recréer un sujet ?

Sub Import_DATA()
Dim LigDep As Long, LigPlan As Long
Dim Cel As Range

  Application.ScreenUpdating = False
  Set bd = Sheets("Index")
  bd.[A1].CurrentRegion.Sort Key1:=bd.Range("K2"), Order1:=xlAscending, _
  Key2:=bd.Range("H2"), Order2:=xlAscending, _
  Key3:=bd.Range("F2"), Order3:=xlAscending, Header:=xlGuess

  ligbd = 2
  Do While ligbd <= bd.[A65000].End(xlUp).Row
    id_rgp = bd.Cells(ligbd, 1)       ' Premier id_rgp

    Sheets("GAB_1").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = id_rgp & "_1"
    Set plan = Sheets(id_rgp & "_1")
    plan.Range("A1").Value = id_rgp

    LigDep = ligbd
    Do While bd.Cells(ligbd, 1) = id_rgp   'parcours  id_rgp traité
      id_arbo = bd.Cells(ligbd, 6)
      Set Cel = plan.Columns("A").Find(what:=id_arbo, LookIn:=xlValues, lookat:=xlWhole)
      If Not Cel Is Nothing Then
        LigPlan = Cel.Row
        id_colonne = bd.Cells(ligbd, 8)
        Data = bd.Cells(ligbd, 10)
        Q = Application.Match(id_colonne, [CodesConges], 0)
        If Not IsError(Q) Then plan.Cells(LigPlan, Q + 2) = Data
      End If
      ligbd = ligbd + 1
    Loop

    Sheets("GAB_2").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = id_rgp & "_2"
    Set plan = Sheets(id_rgp & "_2")
    plan.Range("A1").Value = id_rgp

    ligbd = LigDep
    Do While bd.Cells(ligbd, 1) = id_rgp   'parcours  id_rgp traité
      id_arbo = bd.Cells(ligbd, 6)
      Set Cel = plan.Columns("A").Find(what:=id_arbo, LookIn:=xlValues, lookat:=xlWhole)
      If Not Cel Is Nothing Then
        LigPlan = Cel.Row
        id_colonne = bd.Cells(ligbd, 8)
        Data = bd.Cells(ligbd, 10)
        Q = Application.Match(id_colonne, [CodesConges], 0)
        If Not IsError(Q) Then plan.Cells(LigPlan, Q + 2) = Data
      End If
      ligbd = ligbd + 1
    Loop
  Loop

  'ThisWorkbook.Save
  'Application.Quit
End Sub
9test-mar.xlsm (232.72 Ko)

Bonsoir

A vérifier (si j'ai bien compris)

Effectivement Banzai64, tu as tout compris.

Sauf le classement, i lfaudrait que les onglets marche par paire

3477_gpcol1_1 | 3477_gpcol1_2 |3477_gpcol2_1 |3477_gpcol2_2.

et non 3477_gpcol1_1 |3477_gpcol2_1 | 3477_gpcol1_2 |3477_gpcol2_1 |3477_gpcol2_2.

De plus, en admettant que je décide de ne mettre que 5 colonnes, peux tu me préciser où est la variable à modifier.

j'ai pu voir qu'il fallait modifier

If Bd.Range("H" & LigBd) > Groupe * 6 Then 6 à remplacer par 5

Groupe = Groupe + 1

Sheets("GAB_1").Copy after:=Sheets(Sheets.Count)

ActiveSheet.Name = id_rgp & "_gpcol_" & Groupe & "_1"

Range("A1").Value = id_rgp

Range("C3") = (Groupe * 6) - 5 je n'ai pas trop compris ici, par déduction j'aurais mis (Groupe * 5) - 4 mais pourquoi ?

Range("C3").AutoFill Range("C3:H3"), xlFillSeries ("C3:H3") à remplacer par ("C3:G3")

En tout cas merci énormément.

Bonjour

Une version qui inclut le tri des feuilles : Attention j'ai modifié la numérotation des pages

If Bd.Range("H" & LigBd) > Groupe * 6 Then 6 à remplacer par 5 OUI

Groupe = Groupe + 1

Sheets("GAB_1").Copy after:=Sheets(Sheets.Count)

ActiveSheet.Name = id_rgp & "_gpcol_" & Groupe & "_1"

Range("A1").Value = id_rgp

Range("C3") = (Groupe * 6) - 5 je n'ai pas trop compris ici, par déduction j'aurais mis (Groupe * 5) - 4 mais pourquoi ?

Il faut que le résultat soit 1 quand le groupe = 1 et si chaque page a 5 colonnes la formule devient (Groupe * 5) - 4

Pour 5 colonnes

Groupe 1 : Résultat 1

Groupe 2 : Résultat 6

Groupe 3 : Résultat 11

etc ...

Pour 6 colonnes

Groupe 1 : Résultat 1

Groupe 2 : Résultat 7

Groupe 3 : Résultat 13

etc ...

Range("C3").AutoFill Range("C3:H3"), xlFillSeries ("C3:H3") à remplacer par ("C3:G3") OUI

Bonjour et merci Banzai64.

je sais que je suis embêtant mais en fait je ne dois pas avoir de tri de feuilles comme tu l'as fait. L'ordre des onglets est déterminé par celui de la colonne H de "Index". puis par les GABARIT et RGP COL.

Dans le cas présent je dois avoir ce qui appartient à id_rgp_3477 avant id_rgp_2319.

On doit avoir :

3477_gpcol1_1 | 3477_gpcol1_2 |3477_gpcol2_1 |3477_gpcol2_2 ............ 2319_gpcol1_1 | 2319_gpcol1_2 | 2319_gpcol2_1 |2319_gpcol2_2.

j'ai bien une solution en ajoutant dans le titre de l'onglet le ORD de la feuille Index.

Mais cela fait un titre qui commence à devenir un peu grand

Bonjour

A vérifier

Banzai¨64.

Cela veut dire merci à toi en chinois.

Rechercher des sujets similaires à "remplir onglet fichier base conditions"