Création de feuilles conditions VBA

[fb62840]

Bonjour à toutes et tous,

Voici ce que je souhaite réaliser.

J'ai un classeur qui contient une feuille Nommée Base
Sur cette feuille
Une colonne Référence qui est une référence alphanumérique
Une colonne Lot qui est une référence qui est une valeur numérique (de 1 à 10)

Sur une autre feuille du même classeur nommée Fournisseurs j'ai :
Une colonne Référence Fournisseur
Une colonne Lot qui est une référence numérique (de 1 à 10)

Je souhaite par une macro vb excel créer un classeur
Créer autant de feuilles selon la règle suivante
Nom de feuille = Référence & Lot & Référence Fournisseur

Une autre règle pour la création des feuilles me serait utile, elle consisterait à demander à l'utilisateur à partir de quelle référence il veut créer les feuilles.

Ce qui me permettrait d'avoir une feuille créé pour chacune des référence contenue dans la feuille base et "dupliquée" pour autant de fournisseurs qui appartiennent au Lot

Je parviens à créer les feuilles, à les renommer du contenu de la référence fournisseur, à formater la feuille créée et à remplir les champs qu'elle contient mais je ne parviens pas à trouver de solution pour la duplication conditionnelle.

Merci beaucoup pour votre aide.


Voici le code.

Sub AjoutFeuilles()
Dim LeNombre&
LeNombre = Range("A65536").End(xlUp).Row - 1 '-1 = si en-tête
Application.SheetsInNewWorkbook = LeNombre
Dim wbk As Workbook
Set wbk = Workbooks.Add
For i = 1 To LeNombre
wbk.Worksheets(i).Name = ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 1)

ActiveSheet.Select
'Sélection de l'ensemble des cellules pour la mise en forme de la police
Cells.Select
   With Selection.Font
        .Name = "Trebuchet MS"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
'Ensuite, je fais en sorte de construire et de formater le tableau
'Définition des largeurs de colonnes
    Columns("A:A").Select
    Selection.ColumnWidth = 40
    Columns("B:B").Select
    Selection.ColumnWidth = 8.29
    Columns("C:C").Select
    Selection.ColumnWidth = 9.14
    Columns("D:D").Select
    Selection.ColumnWidth = 10.43
    Columns("E:E").Select
    Selection.ColumnWidth = 13


Range("a1").Select
    ActiveCell.FormulaR1C1 = "Référence :"

    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Lot


    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Référence Forunisseur"


Next i
End Sub

 

[PMO2]

Re : Création de feuilles conditions VBA

Bonjour,

Voyez si ce code répond à votre demande (je n'ai pas compris certaines choses)

Sub AjoutFeuilles()
Dim reponse
Dim C As Range
Dim bool As Boolean
Dim LeNombre&
Dim i&
Dim cpt&
Dim wbk As Workbook
Dim S As Worksheet
LeNombre = Range("A65536").End(xlUp).Row - 1 '-1 = si en-tête
reponse = Application.InputBox(prompt:="Quelle référence ?", Type:=2)
If reponse = False Or reponse = "" Then Exit Sub
Range("a2:a" & LeNombre + 1 & "").Select
For Each C In Range("a2:a" & LeNombre + 1 & "")
  If C = reponse Then
    bool = True
    Exit For
  End If
Next C
If Not bool Then
  MsgBox "La référence " & reponse & " est introuvable"
  Exit Sub
End If
Set wbk = Workbooks.Add(xlWBATWorksheet)
For i = 1 To LeNombre
  If ThisWorkbook.Worksheets("Base").Cells(i + 1, 1) = reponse Then
    cpt& = cpt& + 1
    If cpt& = 1 Then
      Set S = wbk.Sheets(cpt&)
      '--- la mise en forme de la police ---
      With S.Cells.Font
        .Name = "Trebuchet MS"
        .Size = 10
      End With
      '--- construire et formater le tableau ---
      Columns("A:A").ColumnWidth = 40
      Columns("B:B").ColumnWidth = 8.29
      Columns("C:C").ColumnWidth = 9.14
      Columns("D:D").ColumnWidth = 10.43
      Columns("E:E").ColumnWidth = 13
      S.Range("a1") = "Référence :"
      S.Range("D1") = "Lot"
      S.Range("A3") = "Référence Fournisseur"
    Else
      S.Copy After:=wbk.Sheets(wbk.Sheets.Count)
      Set S = ActiveSheet
    End If
    With ThisWorkbook.Worksheets("Base")
      S.Name = .Cells(i + 1, 1) & "_" & .Cells(i + 1, 2)
    End With
  End If
Next i
End Sub

Je mets une pièce jointe pour plus de facilité.

Cordialement.

PMO

 

[fb62840]

Re : Création de feuilles conditions VBA

Merci beaucoup pour ce code.

Il simplifie beaucoup ma rédaction pour la création de la maquette du tableau.

J'ai quelques questions supplémentaires.
Mes références "alphanumériques" sont par exemple (Feuille Base, Colonne A) :
MP 10034 E, MP 10011 G, MP 10022 A
Sur la feuille Base, Colonne B j'ai le numéro d'un lot (de 1 à 10) :
exemples :
2, 4, 10

Sur la feuille Fournisseurs j'ai une colonne Référence Fournisseur exemple :
24BC, 33DE, 29CD

Et sur la feuille Fournisseur j'ai une colonne Lot (numérique de 1 à 10) exemple :
3, 1, 3

Ce que je souhaite obtenir :
1) Demander à l'utilisateur à compter de quel numéro de ligne il veut procéder à la création des feuilles

2) Pour chaque référence alphanumérique, créer autant de feuilles que de fois où il y a correspondance entre le N° du lot présent sur la feuille base et sur la feuille fournisseur

exemple :
Imaginons que l'utilisateur demande la création à compter de la 10ème ligne,
Et :
- qu'en ligne 10 il y ait
Dans la colonne Référence : MP 10034 E
Dans la colonne lot : 3
- que, ligne 11 il y ait
Dans la colonne Référence : MP 10011 G
Dans la colonne lot : 1

Et qu'en colonne Lot sur la feuille fournisseurs :
Il y ait :
colonne référence fournisseur, Colonne Lot :
Fournisseur 1, Lot 1
Fournisseur 2, Lot 2
Fournisseur 3, Lot 3
Fournisseur 4, Lot 1
Fournisseur 5, Lot 3
Fournisseur 6, Lot 1

Cela devrait conduire à la création des feuilles suivantes
MP 10034 E_Fournisseur 3_Lot 3
MP 10034 E_Fournisseur 5_Lot 3
MP 10011 G_Fournisseur 1_Lot 1
MP 10011 G_Fournisseur 4_Lot 1
MP 10011 G_Fournisseur 6_Lot 1

J'espère que ce sera clair pour vous.
Si vous le souhaitez, je peux éventuellement vous adresser un classeur exemple avec le contenu de mes tableaux.

Merci beaucoup pour votre aide,

FB

 

[PMO2]

Re : Création de feuilles conditions VBA

Bonjour,

Essayez ce nouveau code

'### Constantes à adapter (noms des feuilles source) ###
Const BASE As String = "Base"
Const FOURN As String = "Fournisseurs"
'#######################################################

Sub AjoutFeuilles()
Dim reponse
Dim bool As Boolean
Dim var1
Dim var2
Dim i&
Dim j&
Dim wbk As Workbook
Dim S As Worksheet
Dim Sb  As Worksheet
Dim Sf  As Worksheet
Dim LastLig&
Set Sb = Sheets(BASE)
Set Sf = Sheets(FOURN)
reponse = Application.InputBox(prompt:="A compter de quel numéro de ligne doit-on créer des feuilles ?", Type:=1)
If reponse = False Or reponse = "" Then Exit Sub
LastLig& = Sb.Range("A65536").End(xlUp).Row
If reponse > LastLig& Then Exit Sub
reponse = CLng(reponse)
var1 = Sb.Range("a" & reponse & ":b" & LastLig& & "")
var2 = Sf.UsedRange
For i& = 1 To UBound(var1, 1)
  For j& = 2 To UBound(var2, 1) 'j&=2 To... (2 si en-tête sinon j&=1 To...)
    If var1(i&, 2) = var2(j&, 2) Then
      If Not bool Then
        Set wbk = Workbooks.Add(xlWBATWorksheet)
        bool = True
        Set S = wbk.Sheets(wbk.Sheets.Count)
        '--- la mise en forme de la police ---
        With S.Cells.Font
          .Name = "Trebuchet MS"
          .Size = 10
        End With
        '--- construire et formater le tableau ---
        Columns("A:A").ColumnWidth = 40
        Columns("B:B").ColumnWidth = 8.29
        Columns("C:C").ColumnWidth = 9.14
        Columns("D:D").ColumnWidth = 10.43
        Columns("E:E").ColumnWidth = 13
        S.Range("a1") = "Référence :"
        S.Range("D1") = "Lot"
        S.Range("A3") = "Référence Fournisseur"
      Else
        S.Copy After:=wbk.Sheets(wbk.Sheets.Count)
        Set S = ActiveSheet
      End If
      S.Name = var1(i&, 1) & "_" & var2(j&, 1) & "_" & var2(j&, 2)
    End If
  Next j&
Next i&
End Sub

Cordialement.

PMO

 

[fb62840]

Re : Création de feuilles conditions VBA

Bonjour,

Merci beaucoup ! cela fonctionne très bien, j'ai pu adapter à mon cas précis, encore un énorme merci.
Y-a-t-il un moyen de vous joindre car je souhaiterais vous remercier en vous proposant par exemple 2 places de cinéma ou autre chose ?

Sur les feuilles créées il y a certaines cellules qui devrait être remplies avec le contenu de certaines cellules de la feuille fournisseurs et de certaines cellules de la feuille Base

Exemple :
Je récupère la référence fournisseur et en fin de code je modifie ainsi :

 With ThisWorkbook.Worksheets("Base")
      S.Name = .Cells(i + 1, 1) & "_" & .Cells(i + 1, 2)
    End With
    
    
      Else
        S.Copy After:=wbk.Sheets(wbk.Sheets.Count)
        Set S = ActiveSheet
      End If
      S.Range("B3") = var2(j&, 1)
      S.Name = var1(i&, 1) & "_" & var2(j&, 1)
    End If
  Next j&
Next i&
End Sub

Sur la même feuille fournisseur j'ai une colonne avec le Nom du fournisseur que je souhaiterais récupérer, sans doute comme variable V3

Sur la même feuille fournisseur j'ai 3 colonnes avec des prix, et là ça se complique un peu
Le prix à récupérer dépend d'une information contenue sur la feuille base.

Je m'explique :
Sur la feuille base, j'ai une colonne Type, qui peut contenir A, B ou C
Sur la feuille Fournisseurs, j'ai trois colonnes Prix Type A, Prix Type B, Prix Type C
et j'aurais besoin de récupérer comme variable V4 le prix correct
Exemple, si j'ai sur la feuille Base dans la colonne Type la valeur C , je souhaite récupérer sous forme de variable le prix dans la colonne contenant le Prix Type C pour le fournisseur considéré

En outre, sur la feuille Base, il y a plusieurs cellules dont je souhaiterais récupérer le contenu afin de le placer dans une case précise de la feuille créée

J'essaye d'expliquer clairement :
Sur la feuille Base
J'ai une colonne Nom Produit, je souhaiterais récupérer le contenu de la cellule comme une variable pour placer le nom produit dans la case qui convient sur la feuille créée
Toujours sur la feuille Base :
Idem pour le contenu de la cellule dans une colonne nommée Ville en variable 5 par exemple
Idem pour le contenu de la cellule dans une colonne nommée Nombre d'heure Prestation 1 en variable 6
Idem pour le contenu de la cellule dans une colonne nommée Nombre d'heure Prestation 2 en variable 7
Idem pour le contenu de la cellule dans une colonne nommée Nombre d'heure Prestation 3 en variable 8
Idem pour le contenu de la cellule dans une colonne nommée Nombre d'heure Prestation 4 en variable 9
Idem pour le contenu de la cellule dans une colonne nommée Description en variable 10

Et enfin, j'aimerais pouvoir formater la feuille créée
En encadrant certaines cellules ou groupe de cellule de bordures
En remplissant une cellule ou un groupe de cellule d'un fond de couleur
En insérant un caractère spécial (case à cocher) dans certaines cellules

Voilà, Si vous pouvez m'expliquer pour récupérer V3 et V4 et une variable V5 (j'essaierai d'adapter le code moi même pour les autres variables).

Merci beaucoup,
Fabrice