Importer des données d'un tableau à un autre sur une même feuille

Bonjour à tous =)
Je vous explique mon petit soucis

Dans ma feuille intitulée "2022", j'ai 2 tableaux : l'un pour entrer des informations de chantier (de dimension variable car on peut entrer plusieurs chantiers) et un autre tableau ayant pour objectif de comptabiliser toutes les heures d'un même chantier.

Par exemple, si j'ai un chantier nommé "Toto" dans mon tableau d'informations chantier, je voudrai que le tableau qui comptabilise toutes les heures d'un même chantier prenne en compte tout les noms "Toto" et fasse la somme des heures.

J'ai essayé cela mais le résultat n'est pas celui escompté ^^ Ce code permet de copier les données d'une partie du "grand tableau" dans le tableau des heures de chantier mais il ne fait pas la somme :

Sub Importation()
    Dim PlageACopier As Range
    Dim DrLigne&, A&, NumSemaine&

    NumSemaine = Range("G11")

    With Sheets("2022")
        DrLigne = .Range("G" & Rows.Count).End(xlUp).Row

        For A = 1 To DrLigne
            If .Range("G" & A) = NumSemaine Then
                Set PlageACopier = .Range("G" & A + 52 & ":" & "BF" & A + 7)
                PlageACopier.Copy Destination:=Range("BH7")
            End If
        Next A
    End With
End Sub

PS : au passage, j'ai un autre petit soucis (pas réellement un souci mais un peu embêtant quand même); ma feuille "2022" s'actualise à chaque fois que je rentre une valeur dans une case et cela prends trop de temps. J'ai bien essayé de créer une macro qui permet d'actualiser la feuille quand on clique dessus mais rien ne se fait. Quelqu'un aurait une idée ? ^^

Je vous met mon tableau en PJ,

Merci d'avance

Bonjour Flo, bonjour le forum,

Je te propose la macro événementiel BeforeDoubleClick ci-dessous :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'au double-clic dans l'onglet
Dim TP As ListObject 'déclare la variable TP (Tableau Planning)
Dim TI As ListObject 'déclare la variable TI (Tableau Importation)
Dim C As String 'déclare la variable C (Chantier)
Dim T(1 To 4) 'déclare le tableau de 4 variables (Total))

Set TP = Me.ListObjects("Tableau_Semaine") 'définit le tableau structuré TP
Set TI = Me.ListObjects("Tableau7") 'définit le tableau structuré TI
If TI.ListRows.Count > 0 Then TI.DataBodyRange.Delete 'efface les données de TI
If Application.Intersect(Target, TP.DataBodyRange) Is Nothing Then Exit Sub 'si le double-clic a lieu ailleurs que dans le tableau TP, sort de la procédure
Cancel = True 'évite le mode [Édition] lié au doucle-clic
C = Target.Value 'définit le chantier C
For I = 1 To TP.ListRows.Count 'boucle 1 : sur toutes les lignes I de TP
    For J = 1 To TP.ListColumns.Count 'boucle 2 : sur toutes les colonne J de TP
        If TP.DataBodyRange(I, J) = C Then 'condition : si la donnée ligne I colonne J de TP est égale au chantier C
            For K = 1 To 4 'boucle 3 : su les 4 ligne en-dessous du chantier
                T(K) = T(K) + TP.DataBodyRange(I, J).Offset(K, 0) 'calcule de total de chaque type d'heure
            Next K 'prochaine ligne de la boucle 3
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
TI.ListRows.Add 'ajoute une ligne à TI
TI.DataBodyRange(1, 1) = C 'renvoie le chantier C dans la ligne 1 colonne 1 de TI
TI.DataBodyRange(1, 2) = T(1) 'renvoie le total T(1) dans la ligne 1 colonne 2 de TI
TI.DataBodyRange(1, 3) = T(2) 'renvoie letotal T(2) dans la ligne 1 colonne 3 de TI
TI.DataBodyRange(1, 4) = T(3) 'renvoietotal T(3) dans la ligne 1 colonne 4 de TI
TI.DataBodyRange(1, 5) = T(4) 'renvoietotal T(4) dans la ligne 1 colonne 5 de TI
End Sub

Tu double-cliques dans le planning sur le nom d'un chantier et les totaux des différent types d'heures s'affichent dans le tableau structuré Tableau7.

Pour ton dernier problème, cela vient de l'événementielle Change dans le même onglet.Peut-être devrais-tu en réduire le rayon d'action. Regarde ce que j'ai fait dans le code ci-dessus (à adapter à ton cas) :

If Application.Intersect(Target, TP.DataBodyRange) Is Nothing Then Exit Sub 'si le double-clic a lieu ailleurs que dans le tableau TP, sort de la procédure


Bonjour ThauThème =)

Merci de ta réponse très propre et détaillée, un réel plaisir de lire les détails

C'est exactement ce que je recherche, juste une petite précision : je voudrais aussi que les chantiers s'ajoutent les uns après les autres sans écraser les données qui étaient contenues dans le Tableau7 (en fait qu'une ligne du tableau s'ajoute à la suite)

Concernant l'actualisation de la feuille "2022", je vais me pencher sur ton conseil =)

Je te remercie encore pour ton travail et ton aide

Re,

Le code adapté :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'au double-clic dans l'onglet
Dim TP As ListObject 'déclare la variable TP (Tableau Planning)
Dim TI As ListObject 'déclare la variable TI (Tableau Importation)
Dim C As String 'déclare la variable C (Chantier)
Dim T(1 To 4) 'déclare le tableau de 4 variables (Total))
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)
Set TP = Me.ListObjects("Tableau_Semaine") 'définit le tableau structuré TP
Set TI = Me.ListObjects("Tableau7") 'définit le tableau structuré TI

If Application.Intersect(Target, TP.DataBodyRange) Is Nothing Then Exit Sub 'si le double-clic a lieu ailleurs que dans le tableau TP, sort de la procédure
Cancel = True 'évite le mode [Édition] lié au doucle-clic
C = Target.Value 'définit le chantier C
For I = 1 To TP.ListRows.Count 'boucle 1 : sur toutes les lignes I de TP
    For J = 1 To TP.ListColumns.Count 'boucle 2 : sur toutes les colonne J de TP
        If TP.DataBodyRange(I, J) = C Then 'condition : si la donnée ligne I colonne J de TP est égale au chantier C
            For K = 1 To 4 'boucle 3 : su les 4 ligne en-dessous du chantier
                T(K) = T(K) + TP.DataBodyRange(I, J).Offset(K, 0) 'calcule de total de chaque type d'heure
            Next K 'prochaine ligne de la boucle 3
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
Set R = TI.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TI
If Not R Is Nothing Or TI.ListRows.Count = 0 Then 'condition : si aucune occurrence n'est trouvée ou TI ne contient pas encore de ligne
    TI.ListRows.Add 'ajoute une ligne à TI
    LI = TI.ListRows.Count 'définit la ligne LI (dernière ligne de TI)
Else 'sinon (au moins une occurrence trouvée)
    LI = R.Row - TI.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée mois la ligne des en-têtes de TI)
End If 'fin de la condition
TI.DataBodyRange(LI, 1) = C 'renvoie le chantier C dans la ligne LI colonne 1 de TI
TI.DataBodyRange(LI, 2) = T(1) 'renvoie le total T(1) dans la ligne LI colonne 2 de TI
TI.DataBodyRange(LI, 3) = T(2) 'renvoie le total T(2) dans la ligne LI colonne 3 de TI
TI.DataBodyRange(LI, 4) = T(3) 'renvoie le total T(3) dans la ligne LI colonne 4 de TI
TI.DataBodyRange(LI, 5) = T(4) 'renvoie le total T(4) dans la ligne LI colonne 5 de TI
End Sub

Re,

Merci pour ta rapidité =)

J'ai essayé ton code mais il m'affiche ce message d'erreur :

image

Sur cette ligne :

image

Est-ce aussi le cas pour toi ?

Merci d'avance =)

En fait je viens de comprendre ^^

Il faut que je rajoute une ligne au tableau et ça marche =)

Merci à toi

Re

Œuf Corse ! Comme disent les poules à Ajaccio... Supprime le Not dans cette ligne :

If Not R Is Nothing Or TI.ListRows.Count = 0 Then 'condition : si aucune occurrence n'est trouvée ou TI ne contient pas encore de ligne

Désolé. Je navet même pas teste tellement j'étais sûr de ma bêtise...

Pas besoin de rajouter la ligne !

Super c'est nickel =)

Pas de soucis, ton travail est super .

Excuse moi d'en rajouter un peu () mais est-ce que si l'occurrence est déjà présente alors on ne l'a rajoute pas à la suite, comme dans l'exemple ci dessous :

image

Après promis c'est fini ^^

Merci d'avance =)

Re,

Nouveau code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'au double-clic dans l'onglet
Dim TP As ListObject 'déclare la variable TP (Tableau Planning)
Dim TI As ListObject 'déclare la variable TI (Tableau Importation)
Dim C As String 'déclare la variable C (Chantier)
Dim T(1 To 4) 'déclare le tableau de 4 variables (Total))
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)
Set TP = Me.ListObjects("Tableau_Semaine") 'définit le tableau structuré TP
Set TI = Me.ListObjects("Tableau7") 'définit le tableau structuré TI

If Application.Intersect(Target, TP.DataBodyRange) Is Nothing Then Exit Sub 'si le double-clic a lieu ailleurs que dans le tableau TP, sort de la procédure
Cancel = True 'évite le mode [Édition] lié au doucle-clic
C = Target.Value 'définit le chantier C
For I = 1 To TP.ListRows.Count 'boucle 1 : sur toutes les lignes I de TP
    For J = 1 To TP.ListColumns.Count 'boucle 2 : sur toutes les colonne J de TP
        If TP.DataBodyRange(I, J) = C Then 'condition : si la donnée ligne I colonne J de TP est égale au chantier C
            For K = 1 To 4 'boucle 3 : su les 4 ligne en-dessous du chantier
                T(K) = T(K) + TP.DataBodyRange(I, J).Offset(K, 0) 'calcule de total de chaque type d'heure
            Next K 'prochaine ligne de la boucle 3
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1

'************************************************************************************************************************
For I = 1 To TI.ListRows.Count 'boucle sur toutes les lignes I de TI
    If TI.DataBodyRange(I, 1) = C Then Exit Sub 'si la donnée ligne I colonne 1 de TI est égale à C, sort de la procédure
Next I 'prochaine ligne de la boule
'************************************************************************************************************************

Set R = TI.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TI
If R Is Nothing Or TI.ListRows.Count = 0 Then 'condition : si aucune occurrence n'est trouvée ou TI ne contient pas encore de ligne
    TI.ListRows.Add 'ajoute une ligne à TI
    LI = TI.ListRows.Count 'définit la ligne LI (dernière ligne de TI)
Else 'sinon (au moins une occurrence trouvée)
    LI = R.Row - TI.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée mois la ligne des en-têtes de TI)
End If 'fin de la condition
TI.DataBodyRange(LI, 1) = C 'renvoie le chantier C dans la ligne LI colonne 1 de TI
TI.DataBodyRange(LI, 2) = T(1) 'renvoie le total T(1) dans la ligne LI colonne 2 de TI
TI.DataBodyRange(LI, 3) = T(2) 'renvoie le total T(2) dans la ligne LI colonne 3 de TI
TI.DataBodyRange(LI, 4) = T(3) 'renvoie le total T(3) dans la ligne LI colonne 4 de TI
TI.DataBodyRange(LI, 5) = T(4) 'renvoie le total T(4) dans la ligne LI colonne 5 de TI
End Sub

Hé bé c'est super ! Exactement ce que je cherchais ^^

Très très bon travail, merci à toi ThauThème =)

Re,

Dans le code rajouté tu peux le modifier :

For I = 1 To TI.ListRows.Count 'boucle sur toutes les lignes I de TI
    If TI.DataBodyRange(I, 1) = C Then 'si la donnée ligne I colonne 1 de TI est égale à C
        TI.DataBodyRange(I, 1).Select 'sélectionne le chantier
        Exit Sub 'sort de la procédure
    End If
Next I 'prochaine ligne de la boule

Comme ça, le chantier sera pointé car l'utilisateur l'attend en dernière ligne et pas ailleurs...

Mais que demander de plus ^^

Tu veux dire que sans cela, le chantier peut se mettre par forcément à la dernière ligne du tableau7 ?

Merci pour tout =)

Re,

Non le chantier se sera pas ajouté ailleurs.

Si il a déjà été calculé, l'utilisateur, au double-clic, va attendre le résultat dans la dernière ligne et ne va pas comprendre s'il n'arrive pas. Le fait de le sélectionner lui fera comprendre qu'il avait déjà été calculé...

Maintenant, il est clair que tu n'as que quelques lignes de chantiers calculés mais plus tard, ça peut être utile de le mettre en évident en le sélectionnant.

Ah oui après utilisation, très bonne idée =)

Merci pour ton investissement et tes explications en tout cas

Rechercher des sujets similaires à "importer donnees tableau meme feuille"