Transférer des valeurs d'un tableau vers un autre avec une macro (VBA)

Le 02/03/2021 à 11:25

Bonjour à tous,

J'ai un problème, je n'arrive pas à configuré correctement une macro (je suis débutant et c'est vrai que ce n'est pas facile au début).

J'ai un fichier (nom : Planning AJUSTAGE-USINAGE) qui est sous forme de tableau qui va chercher des valeurs sur un autre fichier (nom : Fichier OF010321) qui est aussi sous forme de tableau.

J'ai créé un bouton que j'ai appelé "MAJ DISP" qui doit mettre à jour les valeurs qui sont marquées "DISP" dans mon tableau (Fichier : Planning AJUSTAGE-USINAGE). Mon problème c'est que quand je mets à jour les "DISP" je n'arrive pas à lui dire de positionner les "DISP" sur les bonnes lignes qui correpondent au bon numéro d'OF.

Voilà ce que je veux obtenir :

52planning-ajustage-usinage.xlsm (44.70 Ko)
27fichier-of010321.xlsx (24.71 Ko)
image

Voilà ce que j'obtiens :

image

Tout est plus expliqué sur mon fichier Excel (Planning AJUSTAGE-USINAGE).

Je crois qu'il faut utiliser les conditions If, ce que je veux dire grosso-modo c'est SI dans le tableau du fichier OF010321 on trouve une valeur DISP alors on copie cette valeur dans le tableau du fichier Planning AJUSTAGE-USINAGE à la ligne qui correspond au bon OF. Par contre si il n'y a pas de valeur "DISP" alors on ne copie rien.

Si ma requête n'est pas très clair ou vous voulez plus de renseignements n'hésitez pas.

Merci d'avance à tous.

Bonne journée à vous.

Le 02/03/2021 à 14:35

Bonjour Zelamo, bonjour le forum,

Ci-dessous ton code modifié :

Sub MajDispo()
Dim CD As Workbook 'définit la variable CD (Classeur Destination)
Dim OD As Worksheet 'définit la variable OD (Onglet Destination)
Dim CA As String 'définit la variable CA (Chemin d'Accès)
Dim DL As Integer 'définit la variable DL (Dernière Ligne)
Dim TVD As Variant 'définit la variable TVD (Tableau des Valeurs Destination)
Dim FS As Object
Dim Listallfiles As Object
Dim dateplusrecent As Date
Dim file As Object
Dim Nomfichierimport As String
Dim CS As Workbook 'définit la variable CS (Classeur Source)
Dim OS As Worksheet 'définit la variable OS (Onglet Source
Dim PE As Range 'définit la variable PE (Plage Entière)
Dim PS As Range 'définit la variable PS (Plage Sans première ligne)
Dim I As Integer 'définit la variable I (Incrément)
Dim J As Integer 'définit la variable J (incrément)

Application.ScreenUpdating = False   ' Ne pas mettre à jour l'écran automatiquement
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Planning") 'définit l'onglet OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OD
TVD = OD.Range("A1:P" & DL) 'définit le tableau des valeurs destination TVD

'Recherche du fichier d'import le plus récent contenant Of, OP, He et date debut
Set FS = CreateObject("Scripting.FileSystemObject")
Set Listallfiles = FS.getfolder(DossierFichierImport)
dateplusrecent = DateValue("01/01/1900")
For Each file In Listallfiles.Files
    If StrComp(Left(file.Name, Len(PrefixeNomFichierimport)), PrefixeNomFichierimport, 1) = 0 Then
        If file.DateLastModified > dateplusrecent Then
            dateplusrecent = file.DateLastModified
            Nomfichierimport = file.Name
        End If
    End If
Next
On Error Resume Next
Set CS = Workbooks(Nomfichierimport) 'définit le classeur source
If Err <> 0 Then
    Err.Clear
    Set CS = Workbooks.Open(DossierFichierImport & Nomfichierimport, ReadOnly:=True) 'définit le classeur source
End If
On Error GoTo 0
Set OS = CS.Worksheets(1) 'définit l'onglet source
If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet est filtré, affiche toutes les données
Set PE = OS.Range("A1").CurrentRegion 'définit la plage PE
Set PS = PE.Offset(1, 0).Resize(PE.Rows.Count - 1, PE.Columns.Count) 'définit la plage PS (sans l'en-tête)
PE.AutoFilter Field:=4, Criteria1:="Z001" 'filtre
PE.AutoFilter Field:=19, Criteria1:=Array("H001", "H003"), Operator:=xlFilterValues 'filtre
PE.AutoFilter Field:=23, Criteria1:="DISP", Operator:=xlFilterValues 'filtre
For I = 1 To PS.Rows.Count 'boucle 1 : sur toutes les ligne I de la plage PS
    If PS.Rows(I).Hidden = False Then 'condition : si la ligne est visible
        For J = 7 To UBound(TVD, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs destination TVD
            'multicondition à vérifer, si toutes les conditions sont vérifiées écrit "DISP" dans la cellule ligne J colonne 9 de l'onglet OD et sort de la boucle 2
            If PS(I, 1) = TVD(J, 1) And PS(I, 13) = TVD(J, 2) And PS(I, 3) = TVD(J, 4) And PS(I, 9) = TVD(J, 14) And PS(I, 26) = TVD(J, 5) Then OD.Cells(J, 9).Value = "DISP": Exit For
        Next J 'prochaine ligne de la boucle 2
    End If 'fin de la multicondition
Next I 'prochaine ligne de la boucle 1
CD.Activate 'active le classeur destination CD
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Dispo MAJ" 'message
CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
End Sub

Mais, comme tu as d'un coté un tableau avec 71 colonnes et de l'autre un tableau avec seulement 16 colonnes je ne sais pas sur lesquelles il faut s'appuyer pour savoir de quelle ligne il s'agit. Les deux tableaux ne commencent pas à la même ligne, ne sont pas dans le même ordre et n'ont pas les mêmes en-têtes (un beau bordel quoi !).
Le proposé code compare les colonnes des tableaux source/destination: 1/1, 13/2, 3/4, 9/14, 26/5. Si toutes ces données sont égales alors on récupère la ligne J pour marquer DISP dans la bonne ligne.

Je pense qu'il faudrait un colonne supplémentaire pour chaque tableau qui identifierait de manière unique la ligne avec un code/système. Après le filtre, il suffirait de retrouver l'identifiant unique de ligne dans cette colonne et de le rechercher dans le tableau destination. Une seule condition serait nécessaire pour matcher a coup sûr...

Le 02/03/2021 à 14:47

Bonjour,

Tout d'abord merci pour ta réponse.

Pour ce qui est l'histoire des tableaux on est d'accord que c'est bordélique et très compliqué.... Malheureusement les structures des 2 tableaux ne peuvent pas être modifiable d'ou la complexité de mes difficultés...

Le 02/03/2021 à 17:11

Re,

Tu aurais pu au moins me dire si ça fonctionnait ou pas...

Le 03/03/2021 à 09:01

Bonjour ton code fonctionne pour les fichiers que je t'ai envoyé.

Maintenant j'essaie de transférer de rajouter ton code dans un autre fichier et pour le moment j'ai des problèmes.

Je vais essayer de résoudre ça tout seule.

En tout cas encore merci beaucoup pour ton aide, c'est vraiment très sympa.

Le 04/03/2021 à 10:21

Bonjour,
J'ai réussi à faire fonctionner ton code sur mes autres fichiers s'est presque parfait.

J'ai juste un petit truc qui serait à modifié dans le code. Ca serait de lui dire que si dans le fichier "Planning AJUSTAGE-USINAGE" dans la colonne "Avt" une cellule est marqué en "tt", "ec", "a", "it", "h" alors il ne doit pas mettre à jour la cellule en "DISP" même si dans l'autre fichier, il est marqué en "DISP" (car il peut y avoir des écarts entre les deux fichiers).

image

Je ne sais pas si c'est possible, mais si tu trouves comment faire ca serait vraiment parfait (j'ai essayé plusieurs trucs de mon côté, mais je n'ai pas réussi).
Si, c'est trop compliqué tant pis, tu as déjà fait énormément pour moi donc pas de problèmes et encore merci pour tout.

Bonne journée.

14planning-ajustage-usinage.xlsm (30.73 Ko)
18fichier-of010321.xlsx (27.32 Ko)

Le 07/03/2021 à 10:56

Bonjour Zelamo, bonjour le forum,

Le code adapté :

Sub MajDispo()
Dim CD As Workbook 'définit la variable CD (Classeur Destination)
Dim OD As Worksheet 'définit la variable OD (Onglet Destination)
Dim CA As String 'définit la variable CA (Chemin d'Accès)
Dim DL As Integer 'définit la variable DL (Dernière Ligne)
Dim TE As Variant 'déclare la variable TE (Tableau des Exceptions) <=== changement ici
Dim TVD As Variant 'définit la variable TVD (Tableau des Valeurs Destination)
Dim FS As Object
Dim Listallfiles As Object
Dim dateplusrecent As Date
Dim file As Object
Dim Nomfichierimport As String
Dim CS As Workbook 'définit la variable CS (Classeur Source)
Dim OS As Worksheet 'définit la variable OS (Onglet Source
Dim PE As Range 'définit la variable PE (Plage Entière)
Dim PS As Range 'définit la variable PS (Plage Sans première ligne)
Dim I As Integer 'définit la variable I (Incrément)
Dim J As Integer 'définit la variable J (incrément)
Dim K As Byte 'définit la variable K (incrément) <=== changement ici

Application.ScreenUpdating = False   ' Ne pas mettre à jour l'écran automatiquement
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Planning") 'définit l'onglet OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OD
TE = Array("tt", "ec", "a", "it", "h") 'définit le tableau des exceptions TE <=== changement ici
TVD = OD.Range("A1:P" & DL) 'définit le tableau des valeurs destination TVD

'Recherche du fichier d'import le plus récent contenant Of, OP, He et date début
Set FS = CreateObject("Scripting.FileSystemObject")
Set Listallfiles = FS.getfolder(DossierFichierImport)
dateplusrecent = DateValue("01/01/1900")
For Each file In Listallfiles.Files
    If StrComp(Left(file.Name, Len(PrefixeNomFichierimport)), PrefixeNomFichierimport, 1) = 0 Then
        If file.DateLastModified > dateplusrecent Then
            dateplusrecent = file.DateLastModified
            Nomfichierimport = file.Name
        End If
    End If
Next
On Error Resume Next
Set CS = Workbooks(Nomfichierimport) 'définit le classeur source
If Err <> 0 Then
    Err.Clear
    Set CS = Workbooks.Open(DossierFichierImport & Nomfichierimport, ReadOnly:=True) 'définit le classeur source
End If
On Error GoTo 0
Set OS = CS.Worksheets(1) 'définit l'onglet source
If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet est filtré, affiche toutes les données
Set PE = OS.Range("A1").CurrentRegion 'définit la plage PE
Set PS = PE.Offset(1, 0).Resize(PE.Rows.Count - 1, PE.Columns.Count) 'définit la plage PS (sans l'en-tête)
PE.AutoFilter Field:=4, Criteria1:="Z001" 'filtre
PE.AutoFilter Field:=19, Criteria1:=Array("H001", "H003"), Operator:=xlFilterValues 'filtre
PE.AutoFilter Field:=23, Criteria1:="DISP", Operator:=xlFilterValues 'filtre
For I = 1 To PS.Rows.Count 'boucle 1 : sur toutes les ligne I de la plage PS
    If PS.Rows(I).Hidden = False Then 'condition 1 : si la ligne est visible
        For J = 7 To UBound(TVD, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs destination TVD
            'condition 2 : si toutes les conditions sont vérifiées (multicondition à vérifer)
            If PS(I, 1) = TVD(J, 1) And PS(I, 13) = TVD(J, 2) Then

                '**********************************************************************************************************************************************
                For K = 0 To UBound(TE) 'boucle 3 : sur toutes les exceptions du tableau des exceptions TE
                    If OD.Cells(J, 9).Value = TE(K) Then GoTo suite 'si la cellule ligne J colonne 9 de l'onglet OD est égale à l'exception TE(K) de la boucle 3, va à l'étiquette "suite"
                Next K 'prochaine exception de la boucle 3
                '**********************************************************************************************************************************************

                OD.Cells(J, 9).Value = "DISP": Exit For 'écrit "DISP" dans la cellule ligne J colonne 9 de l'onglet OD et sort de la boucle 2
            End If 'fin de la condition 2
        Next J 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
suite: 'étiquette
Next I 'prochaine ligne de la boucle 1
CD.Activate 'active le classeur destination CD
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Dispo MAJ" 'message
CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
End Sub

Je t'ai signalé les changements...

Le 08/03/2021 à 09:02

Bonjour ThauThème,

C'est EXACTEMENT ce que je voulais !

Merci beaucoup pour tout ton travail qui je sais n'était pas facile et t'a pris du temps.

Je suis réellement très reconnaissant de tout ton travail.

Je pense que je vais clore le sujet.

Encore merci.

Bonne journée et bonne continuation.

Cordialement.

Rechercher des sujets similaires à "transferer valeurs tableau macro vba"