formulaire avec vba

ExcelUtilisateurs

XLDnaute Nouveau
Bonjour a tous,

je suis Giu, je suis pas très grand expert, mes j'ai aime apprendre

je travaille actuellement sur un projet,
voici les détails

  • 6 feuilles dans un Excel
  • un formulaire, un Tableau Générale, Tableau Garçon, Tableau Filles, Tableau Etage2, Sauvegardé en format PDF
Fonction :

Formulaire Copie Cellule A2:N2 vers Tableau General, Efface cellule A2:N2 après Copie
a la prochaine copie, doit se faire en A3:N3 et j'utilise cette formule dans un Macro :​
"pour la copie"
Sheets("Formulaire").Rows(2).Copy Sheets("Tableau Générale").Cells(Rows.Count, 1).End(xlUp)(2)
"pour effacer la formulaire"
Range("A2:N2").Select
Selection.ClearContents
Range("A2").Select

ensuite les donner dans le Tableau Générale vers Tableau Garçon ou fille ou Etage2, si A2 du Tableau Générale contient une des condition : Garçon, filles ou Étage2

la formule utiliser : si.erreur(recherchev(A2;Tableau Génerale!A2:N2;1;FAUX);"")

meme chose pour les autre feuille Fille, Etage2

se que je n'arrive pas c'est pouvoir ecris dans un Macro de faire tout c'est passage dans forcement devoir mettre des formule dans des cellule.

pouvez-vous m'aide svp?


merci d'avance


mes Salutation


Giu.
 

ExcelUtilisateurs

XLDnaute Nouveau
Bonsoir @vgendron,

j'ai travailler sur le fichier, et j'ai apporter des modification aussi au niveau du Macro.

tu peux vérifier la Macro.

tout les information sont dans le Fichier Feuille "Tableau"

il y une possibilité de faire tout les opérations avec une seule Macro

peut tu m'aidé?


Merci bien d'avance
 

Pièces jointes

  • CasierInventaire.xlsm
    67 KB · Affichages: 4
Dernière édition:

ExcelUtilisateurs

XLDnaute Nouveau
Hello

Voir la PJ
ps: il faut renommer les feuilles avec la meme syntaxe dans laquelle elles sont listées
question de quelle page faut t'il mettre la j ai un peux de mal : With Sheets().ListObjects(1)


VB:
NomFeuille = Sheets("Tableau").Range("A2")
    With Sheets().ListObjects(1)
        .ListRows.Add
        LastLine = .ListRows.Count
        Set LigToCopy = Sheets("Tableau").Range("A5:N5")
        LigToCopy.Copy Destination:=.ListRows(LastLine).Range 'on ne fait pour l'instant qu'une copy
    End With
 

vgendron

XLDnaute Barbatruc
j'ai ajouté des commentaires dans la macro
VB:
Sub Pulsante1_Click()
Dim NomFeuille As String
Dim LastLine As Long
Dim LigToCopy As Range

    NomFeuille = Sheets("Tableau").Range("A2") 'on récupère le nom de la feuille selectionnée en A2
    With Sheets(NomFeuille).ListObjects(1) 'avec la table strucuturée (Listobjects) de la feuille selectionnée
        .ListRows.Add 'on ajoute une ligne à la table structurée
        LastLine = .ListRows.Count 'on récupère le numéro de la dernière ligne
        Set LigToCopy = Sheets("Tableau").Range("A5:N5") 'on définit la ligne à copier
        LigToCopy.Copy Destination:=.ListRows(LastLine).Range 'on ne fait pour l'instant qu'une copy de la ligne à la dernière ligne de la table structurée
    End With
    
    With Sheets("Printe PDF") 'on remplit la feuille de PDF avec les éléments de LigToCopy (pas encore effacée)
        .Range("D3") = LigToCopy.Columns(12).Value 'année d'arrivée
        .Range("D5") = LigToCopy.Columns(1).Value 'Nom
        .Range("D6") = LigToCopy.Columns(2).Value 'Prénom
        .Range("D7") = LigToCopy.Columns(3).Value 'Classe
        
        If UBound(Split(NomFeuille, "-")) = 1 Then
            .Range("D8") = Right(Split(NomFeuille, "-")(1), 1) 'Etage
        End If
        
        .Range("D9") = Split(NomFeuille, "-")(0) 'Type 'on garde Garçon ou Fille si il y a l'étage
        
        .Range("D10") = LigToCopy.Columns(4).Value 'Num Casier
        .Range("D11") = LigToCopy.Columns(5).Value 'Num Cadenas
        .Range("D12") = LigToCopy.Columns(6).Value ' Num Clés
        .Range("D14") = LigToCopy.Columns(7).Value 'Caution
        .Range("D16") = LigToCopy.Columns(8).Value 'Clé RS1
        .Range("D17") = LigToCopy.Columns(9).Value 'Clé RS2
        .Range("D18") = LigToCopy.Columns(10).Value 'Clé RS3
        .Range("D20") = LigToCopy.Columns(1).Value 'Prix Clé RS
        .Range("D22") = LigToCopy.Columns(13).Value 'Année Sortie
        .Range("D25") = LigToCopy.Columns(14).Value 'Reviens
        
    End With
    LigToCopy.Clear 'on peut effacer la ligne
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
313 264
Messages
2 096 657
Membres
106 701
dernier inscrit
KOFFI