Copier et mise à jour de données d'un tableau vers un autre tableau

Le 17/10/2023 à 18:15

Bonjour DAN,

Je me permets de revenir vers vous, car je n'arrive pas à comprendre qu'est ce qui pose problème dans le code du fichier "suivi outillages".

Pour rappel, le code doit mettre à jour des données des certaines colonnes et rajouter les nouvelles demandes depuis le fichier "GESTION"

Le problème, peut-être le fait d'être en réseau, la macro s’exécute, n'affiche aucun message, ne rajoute pas les nouvelles demandes et ne met pas à jour les données.

Auriez-vous une idée ?

Option Explicit
Option Compare Text

Sub Importation_Donnees()

'enlever la protection de la feuille
ActiveSheet.Unprotect "mp"

Dim F_GODP  As String ' Variable pour définir le classeur source
Dim tbSource As ListObject, tbDest As ListObject ' Variable pour définir le tableau source et le tableau de destination

'on bloque l'ecran
Application.ScreenUpdating = False

' Chemin du classeur "Gestion" F_GODP = Fichier Gestion
F_GODP = "C:\Users\apalo\Desktop\bug\Gestion.xlsm"

'Validation de l'ouverture en lecture seul
Application.DisplayAlerts = False
' Ouvrir le classeur "Gestion"
Workbooks.Open Filename:=F_GODP

Set tbSource = Workbooks("Gestion.xlsm").Sheets("Charge").ListObjects(1) ' Tableau source du classeur "Gestion" de la feuille "Charge"
Set tbDest = ThisWorkbook.Sheets("Avancement outillages").ListObjects(1) ' Tableau de destination de la feuille "Avancement outillages" du classeur "Suivi outillages"

tbSource.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "Gestion"
tbDest.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "Avancement outillages"

Dim i As Integer, lig As Integer
Dim j As Byte

    For i = 1 To tbSource.ListRows.Count
    If tbDest.DataBodyRange(i, 26) <> "" Then

        On Error Resume Next
        lig = WorksheetFunction.Match(tbSource.DataBodyRange(i, 1).Value, tbDest.ListColumns(1).DataBodyRange.Value, 0)
            If lig > 0 Then 'cas mise a jour de donnees si existantes en feuille Avancement outillages

            With tbDest.DataBodyRange

                For j = 3 To 22 'remise a jour des colonnes C a V
                    .Item(lig, j) = tbSource.DataBodyRange(i, j).Value ' Mise à jour des données des colonnes C a V
                Next j
                    .Item(lig, 23) = tbSource.DataBodyRange(i, 25).Value 'Date butoire
                    .Item(lig, 24) = tbSource.DataBodyRange(i, 41).Value 'Suivid'avancement
                    .Item(lig, 25) = tbSource.DataBodyRange(i, 34).Value 'Prio ODP
                    .Item(lig, 26) = tbSource.DataBodyRange(i, 39).Value 'Statut
                    .Item(lig, 27) = tbSource.DataBodyRange(i, 40).Value 'Ressource
            End With

        Else: 'cas ajout ligne de donnees si non existantes en feuille Charge
            With tbDest
                If .ListRows.Count = 0 Then
                    .ListRows.Add: lig = 1
                Else: .ListRows.Add: lig = .ListRows.Count
                End If
                With .DataBodyRange
                    For j = 1 To 22 'ajout nouvelles donnees des colonnes A a V
                    .Item(lig, j) = tbSource.DataBodyRange(i, j).Value 'ajoute des donnees colonnes A a V
                    Next j
                    .Item(lig, 23) = tbSource.DataBodyRange(i, 25).Value 'Date butoire
                    .Item(lig, 24) = tbSource.DataBodyRange(i, 41).Value 'Suivid'avancement
                    .Item(lig, 25) = tbSource.DataBodyRange(i, 34).Value 'Prio ODP
                    .Item(lig, 26) = tbSource.DataBodyRange(i, 39).Value 'Statut
                    .Item(lig, 27) = tbSource.DataBodyRange(i, 40).Value 'Ressource
                End With
            End With
        End If
        On Error GoTo 0
        lig = 0
      End If
    Next i

'Fermer le fichier "Gestion" sans l'enregistrer
Workbooks("Gestion.xlsm").Close savechanges:=False

'on débloque l'ecran
Application.ScreenUpdating = True

'Positionner le cursseur sur la dernière ligne du tableau de la colonne A
tbDest.DataBodyRange(tbDest.ListRows.Count, 1).Select

'Remettre la protection de la feuille
ActiveSheet.Protect "mp"

'Activer l'utilisation des filtres auto avec la protection de la feuille
Sheets("Avancement Outillages").Protect Password:="Scorpion", AllowFiltering:=True, userinterfaceonly:=True

End Sub
Le 17/10/2023 à 18:55

Bonjour

Je suppose que ce code est bien placé dans le fichier Suivi ?

Si oui, vous avez une condition qui doit être respectée à savoir que la colonne 26 dans le fichier Suivi ne doit pas être vide.

Je pense qu'en cas de mise à jour, cela est bon mais qu'en cas d'ajout de données qui n'existent pas encire, le code ne les rajoute pas

Pouvez-vous vérifier ?

Le 17/10/2023 à 19:06

Oui, le code est bien dans le fichier suivi.

Concernant la colonne 26, il n'y a aucun vide.

Le 17/10/2023 à 21:36

Je crois que l'erreur vient de test, car si j'ignore la partie du code <IF>, cela fonctionne.

For i = 1 To tbSource.ListRows.Count

If tbDest.DataBodyRange(i, 26) <> "" Then

Je vais voir dans le temps.

Le 18/10/2023 à 11:59

Re

Pourquoi avez-vous rajouté la ligne If tbDest.DataBodyRange(i, 26) <> "" Then ?

Quelle est la règle ?

De mon coté, le fichier suivi importe tout du fichier Gestion.
- Si la ligne existe on remplace les données (car une ligne peut avoir été modifiée dans le fichier gestion)
- Si la ligne n'existe pas encore dans le fichier Suivi, elle doit être crée.

en ajoutant la ligne if tbdest....., vous ne savez pas :
- ajouter les nouvelles lignes venant du fichier gestion
- ajouter les infos éventuellement modifiées d'une ligne existante dans le fichier gestion

Le 18/10/2023 à 17:40

Bonjour DAN,

Concernant la ligne que j'avais rajoutée, c'était pour faire un test.

J'ai bien supprimé cette partie du code et la mise à jour ainsi que le rajout des nouvelles demandes ne se font pas.

Ce que je trouve bizarre, c'est que j'arrive à le faire fonctionner chez moi mais au boulot, il ne fonction pas.

Pourtant 0 problème avec le fichier des demandes outillages et le fichier Gestion qui ne sont pas dans le même répertoire du réseau.

je sèche et cela me pose énormément de problème.

Je remets le code du fichier suivi des demandes.

Option Explicit
Option Compare Text

Sub Importation_Donnees()

'enlever la protection de la feuille
ActiveSheet.Unprotect "mp"

Dim F_GODP  As String ' Variable pour définir le classeur source
Dim tbSource As ListObject, tbDest As ListObject ' Variable pour définir le tableau source et le tableau de destination

'on bloque l'ecran
Application.ScreenUpdating = False

' Chemin du classeur "Gestion ODP" F_GODP = Fichier Gestion ODP
F_GODP = "chemin réseau\Gestion ODP.xlsm"

'Validation de l'ouverture en lecture seul
Application.DisplayAlerts = False
' Ouvrir le classeur "Gestion ODP"
Workbooks.Open Filename:=F_GODP

Set tbSource = Workbooks("Gestion ODP.xlsm").Sheets("Charge").ListObjects(1) ' Tableau source du classeur "Gestion ODP" de la feuille "Charge"
Set tbDest = ThisWorkbook.Sheets("Avancement outillages").ListObjects(1) ' Tableau de destination de la feuille "Avancement outillages" du classeur "Suivi outillages"

tbSource.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "Gestion ODP"
tbDest.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "Avancement outillages"

Dim i As Integer, lig As Integer
Dim j As Byte

    For i = 1 To tbSource.ListRows.Count

        On Error Resume Next
        lig = WorksheetFunction.Match(tbSource.DataBodyRange(i, 1).Value, tbDest.ListColumns(1).DataBodyRange.Value, 0)
        If lig > 0 Then 'cas mise a jour de donnees si existantes en feuille Avancement outillages

            With tbDest.DataBodyRange
                For j = 3 To 22 'remise a jour des colonnes C a V
                .Item(lig, j) = tbSource.DataBodyRange(i, j).Value ' Mise à jour des données des colonnes C a V
                Next j
                    .Item(lig, 23) = tbSource.DataBodyRange(i, 25).Value 'Date butoire
                    .Item(lig, 24) = tbSource.DataBodyRange(i, 41).Value 'Suivid'avancement
                    .Item(lig, 25) = tbSource.DataBodyRange(i, 34).Value 'Prio ODP
                    .Item(lig, 26) = tbSource.DataBodyRange(i, 39).Value 'Statut
                    .Item(lig, 27) = tbSource.DataBodyRange(i, 40).Value 'Ressource
            End With

        Else: 'cas ajout ligne de donnees si non existantes en feuille Charge
            With tbDest
                If .ListRows.Count = 0 Then
                    .ListRows.Add: lig = 1
                Else: .ListRows.Add: lig = .ListRows.Count
                End If
                With .DataBodyRange
                    For j = 1 To 22 'ajout nouvelles donnees des colonnes A a V
                    .Item(lig, j) = tbSource.DataBodyRange(i, j).Value 'ajoute des donnees colonnes A a V
                    Next j
                        .Item(lig, 23) = tbSource.DataBodyRange(i, 25).Value 'Date butoire
                        .Item(lig, 24) = tbSource.DataBodyRange(i, 41).Value 'Suivid'avancement
                        .Item(lig, 25) = tbSource.DataBodyRange(i, 34).Value 'Prio ODP
                        .Item(lig, 26) = tbSource.DataBodyRange(i, 39).Value 'Statut
                        .Item(lig, 27) = tbSource.DataBodyRange(i, 40).Value 'Ressource
                End With
            End With
        End If
        On Error GoTo 0
        lig = 0

    Next i

'Fermer le fichier "Gestion ODP" sans l'enregistrer
Workbooks("Gestion ODP.xlsm").Close savechanges:=False

'on débloque l'ecran
Application.ScreenUpdating = True

'Positionner le cursseur sur la dernière ligne du tableau de la colonne A
tbDest.DataBodyRange(tbDest.ListRows.Count, 1).Select

'Remettre la protection de la feuille
ActiveSheet.Protect "mp"

'Activer l'utilisation des filtres auto avec la protection de la feuille
Sheets("Avancement Outillages").Protect Password:="mp", AllowFiltering:=True, userinterfaceonly:=True

End Sub
Le 18/10/2023 à 18:27

J'ai bien supprimé cette partie du code et la mise à jour ainsi que le rajout des nouvelles demandes ne se font pas

Désactivez le On error resume next dans le ccde.
Là cela va probablement surligner une ligne en jaune. Il suffira de trouver le pourquoi

Je remets le code du fichier suivi des demandes.

Si c'est le même qu'hier, nul besoin. Cela complique car vous travaillez avec trois fichiers

Le 18/10/2023 à 19:01

Je viens de partir du boulot, je testerai demain et je vous tiendrai informé.

Merci bonne soirée.

Le 19/10/2023 à 08:57

Bonjour DAN,

J’ai trouvé l’erreur.

J’avais oublié de changer le chemin du fichier gestion qui était dans un dossier test.

Du coup normal que rien ne d’actualiser.

Bonne journée.

Rechercher des sujets similaires à "copier mise jour donnees tableau"