XL 2013 VBA qui crée des tableaux en fonction d'une liste de données

onyirimba

XLDnaute Occasionnel
Supporter XLD
Bonjour,

Est-il possible d'obtenir une programmation VBA qui crée des tableaux en fonctions d'une liste de données (22001ATU1...) ?

Les tableaux sont à crées dans l'onglet " détail des heures " selon le même modèle que les tableaux existants en fonction du nombre de données (22001ATU1...) situées en colonne A de l'onglet "PFA 01 2022"

=> chaque nouveau tableau de l'onglet "détail des heures" crée doit être mis à jour en colonne A avec les données de la colonne A de l'onglet "PFA 01 2022"

=> Sachant que la liste de données en colonne A de l'onglet "PFA 01 2022" peut être plus importante ou moins importante (elle peut se terminer en ligne 25, 30, ou 45)

=> Par conséquent : si il y a 8 données en colonne A de l'onglet "PFA 01 2022" => il doit y avoir 8 tableaux dans l'onglet " détail des heures "
si il y a 12 données en colonne A de l'onglet "PFA 01 2022" => il doit y avoir 12 tableaux dans l'onglet " détail des heures "

J'ai joint un fichier qui illustre mes propos


1646906058431.png



1646906071384.png


Merci beaucoup pour votre aide.

Cordialement
 

Pièces jointes

  • Suivi Variation VBA VBA VBA Version 2.xlsm
    105 KB · Affichages: 7

Robert

XLDnaute Barbatruc
Bonsoir Onyirimba, bonsoir le forum,

En pièce jointe ton fichier modifié avec un bouton, un onglet Modèle en plus et ce code :

VB:
Sub Macro1()
Dim OM As Worksheet 'déclare la variable OM (Onglet Modèle)
Dim OP As Worksheet 'déclare la variable OP (Onglet PFA 01 2022)
Dim OD As Worksheet 'déclare la variable OD (Onglet Détail des heures)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OM = Worksheets("Modèle") 'définit l'onglet OM
Set PL = OM.Range("A8:K19") 'définit la plage PL
Set OP = Worksheets("PFA 01 2022") 'définit l'onglet OP
DL = OP.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OP
Set OD = Worksheets("Détail des heures") 'définit l'onglet OD
OD.Rows(8 & ":" & Application.Rows.Count).Delete 'efface les anciennes données de l'onglet OD
TV = OP.Range(OP.Cells(17, "A"), OP.Cells(DL, "A")) 'définit le tableau des valeurs TV
Set DEST = OD.Range("A8") 'initialise la cellule de destination DEST
For I = 1 To UBound(TV, 1) 'boucle sur toutes les ligne I du tableau des valeurs
    PL.Copy DEST 'copie la plage PL dans la cellule de destination DEST
    DEST.Resize(11, 1).Value = TV(I, 1) 'copie la donnée ligne I colonne 1 de TV dans la cellue de destination DEST redimensionnée
    Set DEST = DEST.Offset(13, 0) 'redéfinit la cellule de destination DEST
Next I 'prochaine ligne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
OD.Activate 'active l'onglet OD
MsgBox "Tableaux crées !" 'message
End Sub
Clique sur le bouton Création des Tableaux...
 

Pièces jointes

  • Onyirimba_ED_v01.xlsm
    121.4 KB · Affichages: 4

onyirimba

XLDnaute Occasionnel
Supporter XLD
Bonjour,

J'ai une question :

Est-ce que la liste des données prise en compte par programmation VBA peut s'arrêter à la dernière données en bleu précédent une cellule vide (dans le cas ici présent c'est 2200TRRDF ) => donc dans ce cas les données "provisions" et "2200OPOR" "2200 RISKS" ne doivent pas être prise en compte pour la création des tableaux

Merci beaucoup

1646989172179.png
 
Dernière édition:

Robert

XLDnaute Barbatruc
Bonjour Onyirimba, bonjour le forum,

Dans ce cas essaie comme ça :

VB:
Sub Macro1()
Dim OM As Worksheet 'déclare la variable OM (Onglet Modèle)
Dim OP As Worksheet 'déclare la variable OP (Onglet PFA 01 2022)
Dim OD As Worksheet 'déclare la variable OD (Onglet Détail des heures)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OM = Worksheets("Modèle") 'définit l'onglet OM
Set PL = OM.Range("A8:K19") 'définit la plage PL
Set OP = Worksheets("PFA 01 2022") 'définit l'onglet OP
DL = OP.Range("A6").End(xlDown).Row 'définit la dernière ligne éditée avant un ligne vide dans la colonne A de l'onglet OP
Set OD = Worksheets("Détail des heures") 'définit l'onglet OD
OD.Rows(8 & ":" & Application.Rows.Count).Delete 'efface les anciennes données de l'onglet OD
TV = OP.Range(OP.Cells(7, "A"), OP.Cells(DL, "A")) 'définit le tableau des valeurs TV
Set DEST = OD.Range("A8") 'initialise la cellule de destination DEST
For I = 1 To UBound(TV, 1) 'boucle sur toutes les ligne I du tableau des valeurs
    If TV(I, 1) <> "" Then 'condition : si la donnée ligne I colonne 1 de TV n'est pas vide
        PL.Copy DEST 'copie la plage PL dans la cellule de destination DEST
        DEST.Resize(11, 1).Value = TV(I, 1) 'copie la donnée ligne I colonne 1 de TV dans la cellue de destination DEST redimensionnée
        Set DEST = DEST.Offset(13, 0) 'redéfinit la cellule de destination DEST
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
OD.Activate 'active l'onglet OD
MsgBox "Tableaux crées !" 'message
End Sub

Deux petites choses :
1. Il y avait une erreur dans mon premier code :

Code:
TV = OP.Range(OP.Cells(17, "A"), OP.Cells(DL, "A")) 'définit le tableau des valeurs TV
devait être :
Code:
TV = OP.Range(OP.Cells(7, "A"), OP.Cells(DL, "A")) 'définit le tableau des valeurs TV
2. Si tu veux progresser en VBA, essaie de comprendre les codes et pas juste de les appliquer et de vérifier que ça correspond à ta requête. Pour trouver la dernière cellule éditée d'une colonne on part de la fin et on remonte, pour trouver la dernière cellule avant une ligne vide on part du début et on descend... Regarde la différence des deux codes proposés...
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
299 878
Messages
1 979 752
Membres
206 857
dernier inscrit
Pageee