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

Le 05/10/2023 à 10:12

Bonjour,

C'est le fichier GESTION qui pilote les données (Non attaqué ; En cours; En stand-by; Annulé et Soldé)

Ok.

- ouvrez votre fichier gestion
- dans la Sub Importation_Demandes(), allez à la ligne --> For i = 1 To tbSource.ListRows.Count
- juste en dessous mettez cette ligne

If tbDest.DataBodyRange(i, 29) <> "Annulé" Or tbDest.DataBodyRange(i, 29) <> "Soldé" Then

- juste avant le Next i, ajoutez --> END IF

Refaite un essai

Rem : juste une question, votre fichier gestion ne contient qu''une seul feuille ?

Le 05/10/2023 à 16:29

Bonjour,

Je viens de tester le code et celui-ci bloque sur cette ligne.

If tbDest.DataBodyRange(i, 29) <> "Annulé" Or tbDest.DataBodyRange(i, 29) <> "Soldé" Then
Le 05/10/2023 à 17:16

Je viens de tester le code et celui-ci bloque sur cette ligne.

Vous avez ajouté le END IF au moins ?

Sinon, vous avez bien placé cette ligne dans le fichier gestion et code Sub Importation_Demandes() ?

Le 05/10/2023 à 18:42

Oui j’ai bien respecté votre consignes.

J’essaie de nouveau des que je rentre du boulot.

Le 05/10/2023 à 22:16

Je viens de tester le code et effectivement j’avais fait une erreur de frappe.

Le code s’exécute bien mais ne fonctionne pas.

Si une modification est faite dans le fichier demandes outillages malgré que la ligne est soldé ou annulé, la mise à jour ce fait quand même. Et inversement également.

Oui le fichier gestion a et aura plusieurs feuilles.

Listés déroulantes, TCD, tableaux de bord et d’autres.

Le 06/10/2023 à 09:38

Si une modification est faite dans le fichier demandes outillages malgré que la ligne est soldé ou annulé, la mise à jour ce fait quand même. Et inversement également

Heu là je ne comprends pas car j'ai fait le test avant de vous envoyer une solution.
Si le code rencontre un des deux termes soldé ou annulé, avec la ligne IF THEN les lignes ne sont pas exécutées

Toutefois, dans le module où se trouve le code, tout en haut avant la première sub (donc avant Sub Importation_demandes),vérifiez que vous avez ces deux lignes. Si non ajoutez-les

Option Explicit
Option Compare Text
Le 06/10/2023 à 14:59

Bonjour DAN,

Je viens de refaire le test et je vous confirme que cela n'empêche pas la mise à jour.

Petite question pour que je comprenne bien le code.

If tbDest.DataBodyRange(i, 39) <> "Annulé" Or tbDest.DataBodyRange(i, 39) <> "Soldé" Then

On est d'accord, que si ce code est dans le fichier GESTION,

cela veut dire que si dans la colonne 39 (colonne du statut de ligne suite à mon évolution), les conditions sont différentes de (Annulé ou soldé) alors réaliser la suite du code importation_demandes sinon passer à la ligne suivante ?

Pour moi, c'est ce que je cherche à réaliser.

Ci-dessous le code du fichier GESTION.

Option Explicit
Option Compare Text
----------------------------
Sub Importation_Demandes()

'on bloque l'ecran
Application.ScreenUpdating = False

Dim F_DO  As String
Dim tbSource As ListObject, tbDest As ListObject

' Chemin du classeur "Demande outillage"
F_DO = "C:\Users\apalo\Desktop\ODP\Demandes outillages.xlsm"

Application.EnableEvents = False
' Ouvrir le classeur "Demandes outillages"
Workbooks.Open Filename:=F_DO
Application.EnableEvents = True

Set tbSource = Workbooks("Demandes outillages.xlsm").Sheets("Demandes outillages").ListObjects(1)
Set tbDest = ThisWorkbook.Sheets("Charge").ListObjects(1)

tbSource.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "Demandes outillages"
tbDest.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "CHARGE"

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

    For i = 1 To tbSource.ListRows.Count
        If tbDest.DataBodyRange(i, 39) <> "Annulé" Or tbDest.DataBodyRange(i, 39) <> "Soldé" 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 Charge

            With tbDest.DataBodyRange
                For j = 3 To 18 'remise a jour des colonnes C a R
                    .Item(lig, j) = tbSource.DataBodyRange(i, j).Value
                Next j
            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 18 'ajout nouvelles donnees des colonnes A a R
                        .Item(lig, j) = tbSource.DataBodyRange(i, j).Value 'ajoute des donnees colonnes A a R
                    Next j
                End With
            End With
        End If
        On Error GoTo 0
        lig = 0
         End If
    Next i

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

Call importation_suivi

Range("A" & Rows.Count).End(xlUp).Offset(0, 0).Select

End Sub

----------------------------

Sub importation_suivi()
Dim F_SO As String
Dim tbSource As ListObject, tbDest As ListObject
Dim fichier As String

'on bloque l'ecran
Application.ScreenUpdating = False

fichier = "Suivi outillages.xlsm"
F_SO = "C:\Users\apalo\Desktop\ODP\" & fichier ' Chemin du classeur "Suivi outillage"

' Ouvrir le classeur "Suivi outillages"
Workbooks.Open Filename:=F_SO

Set tbDest = ThisWorkbook.Sheets("CHARGE").ListObjects(1)
Set tbSource = Workbooks(fichier).Sheets("Avancement outillages").ListObjects(1)

tbSource.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "Suivi outillages"
tbDest.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "CHARGE"

Dim i As Integer, lig As Integer

For i = 1 To tbSource.ListRows.Count

    On Error Resume Next 'gestion erreur sur variable lig
    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 numero identification est dans le fichier suivi outillage
    With tbDest.DataBodyRange
            .Item(lig, 27) = tbSource.DataBodyRange(i, 28).Value 'Validation de saisie des données
            .Item(lig, 28) = tbSource.DataBodyRange(i, 30).Value 'IDG outillages
            .Item(lig, 37) = tbSource.DataBodyRange(i, 31).Value 'Etat d'avancement
            .Item(lig, 29) = tbSource.DataBodyRange(i, 32).Value 'Fournisseur
            .Item(lig, 30) = tbSource.DataBodyRange(i, 33).Value 'Prix d'achat
            .Item(lig, 31) = tbSource.DataBodyRange(i, 34).Value 'NI
            .Item(lig, 32) = tbSource.DataBodyRange(i, 36).Value 'Date prévue
            .Item(lig, 33) = tbSource.DataBodyRange(i, 29).Value 'Commentaire
        End With
    End If
    On Error GoTo 0
    lig = 0 'remettre variable à 0
Next i
'Fermer le fichier "suivi outillages" et enregistrer
Workbooks(fichier).Close savechanges:=True
End Sub
Le 06/10/2023 à 15:21

On est d'accord, que si ce code est dans le fichier GESTION,

cela veut dire que si dans la colonne 39 (colonne du statut de ligne suite à mon évolution), les conditions sont différentes de (Annulé ou soldé) alors réaliser la suite du code importation_demandes sinon passer à la ligne suivante ?

Oui vous avez compris sauf que je viens de voir que dans la ligne IF il faut remplacer le OR par AND

Honte à moi et vraiment désolé de vous avoir faire votre temps sur le sujet

edit : au fait pourquoi cette ligne dans votre code ?

Range("A" & Rows.Count).End(xlUp).Offset(0, 0).Select
Le 06/10/2023 à 15:41

Super ça fonctionne bien.

Du coup, la mise à jour est moins longue.

Encore a grand merci à vous pour le temps passé à m'aider dans mon projet.

il est fort possible que je sollicite de nouveau de l'aide soit dans cette discussion ou sous une autre demande en fonction du besoin.

merci encore

Le 06/10/2023 à 15:43
Range("A" & Rows.Count).End(xlUp).Offset(0, 0).Select

Pour cette ligne, c'est que je cherche à me positionner sur la dernière ligne du tableau après avoir réalisé la mise à jour.

Le 06/10/2023 à 15:48

Pour cette ligne, c'est que je cherche à me positionner sur la dernière ligne du tableau après avoir réalisé la mise à jour.

Mettez ceci plutôt :

tbDest.DataBodyRange(tbDest.ListRows.Count, 1).Select
Le 06/10/2023 à 15:58

Merci, je viens de trouver pourquoi cela ne fonctionner pas.

J'avais oublié de débloquer l'écran. 

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

tbDest.DataBodyRange(tbDest.ListRows.Count, 1).Select
Le 06/10/2023 à 16:25

Du coup je pense que mes codes pour masquer et grouper des colonnes ne sont pas correctement écrits?

Ils fonctionnent mais bon.

Sub masqueCol()
    Range("d:d,e:e,h:h,L:m,t:t,v:v").EntireColumn.Hidden = True
End Sub
Sub afficheCol()
    Range("d:v").EntireColumn.Hidden = False
End Sub

Sub Developper()
ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8
End Sub

Sub reduire_col()
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
End Sub
Le 06/10/2023 à 18:58

Du coup je pense que mes codes pour masquer et grouper des colonnes ne sont pas correctement écrits?

Oui c'est bon. On pourrait masquer le faire avec Listobject mais il y aurait plus de ligne vu que les colonnes sont discontinues

Par contre pour Masquer et démasquer, vous pouvez faire un seul code au lieu de deux

Sub masquedemasque()
Dim plage As Range

Set plage = Thisworkbook.sheets("CHARGE").Range("d:d,e:e,h:h,L:m,t:t,v:v")
plage.EntireColumn.Hidden = Not plage.EntireColumn.Hidden
End Sub

Crdlt

Le 06/10/2023 à 21:54

Merci bien, c'est parfait comme à chaque fois.

cdt

David

Le 10/10/2023 à 21:01

Bonsoir DAN,

Petite question, j'aimerais que lors de l'importation des demandes outillages dans le fichier gestion, les cellules vides de la colonne Date du besoin (colonne 12) soient renseignées par ADU.

Merci d'avance.

Cdt

David

Option Explicit
Option Compare Text
Sub Importation_Demandes()

'on bloque l'ecran
Application.ScreenUpdating = False

Dim F_DO  As String
Dim tbSource As ListObject, tbDest As ListObject

' Chemin du classeur "Demande outillage"
F_DO = "C:\Users\apalo\Desktop\ODP\Demandes outillages.xlsm"

Application.DisplayAlerts = False 'Validation de l'ouverture en lecture seul

Application.EnableEvents = False
' Ouvrir le classeur "Demandes outillages"
Workbooks.Open Filename:=F_DO
Application.EnableEvents = True

Set tbSource = Workbooks("Demandes outillages.xlsm").Sheets("Demandes outillages").ListObjects(1)
Set tbDest = ThisWorkbook.Sheets("Charge").ListObjects(1)

tbSource.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "Demandes outillages"
tbDest.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "CHARGE"

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

    For i = 1 To tbSource.ListRows.Count
        If tbDest.DataBodyRange(i, 39) <> "Annulé" And tbDest.DataBodyRange(i, 39) <> "Soldé" 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 Charge

            With tbDest.DataBodyRange
                For j = 3 To 18 'remise a jour des colonnes C a R
                    .Item(lig, j) = tbSource.DataBodyRange(i, j).Value
                Next j
            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 18 'ajout nouvelles donnees des colonnes A a R
                        .Item(lig, j) = tbSource.DataBodyRange(i, j).Value 'ajoute des donnees colonnes A a R
                    Next j
                End With
            End With
        End If
        On Error GoTo 0
        lig = 0
         End If
    Next i

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

Call importation_suivi

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

tbDest.DataBodyRange(tbDest.ListRows.Count, 1).Select

End Sub

Sub importation_suivi()
Dim F_SO As String
Dim tbSource As ListObject, tbDest As ListObject
Dim fichier As String

'on bloque l'ecran
Application.ScreenUpdating = False

fichier = "Suivi outillages.xlsm"
F_SO = "C:\Users\apalo\Desktop\ODP\" & fichier ' Chemin du classeur "Suivi outillage"

' Ouvrir le classeur "Suivi outillages"
Workbooks.Open Filename:=F_SO

Set tbDest = ThisWorkbook.Sheets("CHARGE").ListObjects(1)
Set tbSource = Workbooks(fichier).Sheets("Avancement outillages").ListObjects(1)

tbSource.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "Suivi outillages"
tbDest.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "CHARGE"

Dim i As Integer, lig As Integer

For i = 1 To tbSource.ListRows.Count

    On Error Resume Next 'gestion erreur sur variable lig
    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 numero identification est dans le fichier suivi outillage
    With tbDest.DataBodyRange
            .Item(lig, 27) = tbSource.DataBodyRange(i, 28).Value 'Validation de saisie des données
            .Item(lig, 28) = tbSource.DataBodyRange(i, 30).Value 'IDG outillages
            .Item(lig, 37) = tbSource.DataBodyRange(i, 31).Value 'Etat d'avancement
            .Item(lig, 29) = tbSource.DataBodyRange(i, 32).Value 'Fournisseur
            .Item(lig, 30) = tbSource.DataBodyRange(i, 33).Value 'Prix d'achat
            .Item(lig, 31) = tbSource.DataBodyRange(i, 34).Value 'NI
            .Item(lig, 32) = tbSource.DataBodyRange(i, 36).Value 'Date prévue
            .Item(lig, 33) = tbSource.DataBodyRange(i, 29).Value 'Commentaire
        End With
    End If
    On Error GoTo 0
    lig = 0 'remettre variable à 0
Next i
'Fermer le fichier "suivi outillages" et enregistrer
Workbooks(fichier).Close savechanges:=False

End Sub
Le 11/10/2023 à 14:13

Bonjour

.....les cellules vides de la colonne Date du besoin (colonne 12) soient renseignées par ADU

Dans le code Sub Importation_demandes, vous remplacez :

1. cette partie de code dans la boucle FOR j = 3 to 18

For j = 3 To 18 'remise a jour des colonnes B a R
    If j = 12 And tbSource.DataBodyRange(i, j).Value = vbNullString Then 'cas cellule vide en colonne 12
        .Item(lig, j) = "ADU"
    Else: .Item(lig, j) = tbSource.DataBodyRange(i, j).Value
    End If
Next j

2. cette partie de code dans la boucle FOR j = 1 to 18

For j = 1 To 18 'ajout nouvelles donnees des colonnes A a R
    If j = 12 And tbSource.DataBodyRange(i, j).Value = vbNullString Then 'cas cellule vide en colonne 12
        .Item(lig, j) = "ADU"
    Else: .Item(lig, j) = tbSource.DataBodyRange(i, j).Value
    End If
Next j

Crdlt

Le 11/10/2023 à 20:52

Bonsoir DAN,

Merci pour votre réponse.

Je mets le code de côté car je pense que ce n'est pas la bonne solution à mon problème.

il faut plutôt que je trouve comment obliger un format de saisie des cellules dans la date du besoin du fichier demandes outillages.

Est-ce qu'il est possible de faire cela sans macro par une fonction ou autre, ou bien peut-on plutôt mettre un calendrier qui apparaît lorsque l'on clique sur la cellule ?

Mon code rentre une date calculer par macro qui devrait résoudre ce problème mais les demandeurs risquent de la remplacer par ADU ou ASAP et cela me pose problème pour mes TCD.

Pour info, ils ont besoin d'avoir accès à cette donnée et la modifier suivant la date pour laquelle ils sont besoins des outillages.

Cdt

David

Sub nouvelles_demandes()

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

Dim ligne As Integer 'Déclaration de la variable "ligne"
Dim tb As ListObject

Call Annulation_des_filtres 'Exécution du code "Sub Annulation_des_Filtres()

Set tb = Sheets("Demandes outillages").ListObjects("TBD_OUT")
With tb
    If .ListRows.Count = 0 Then
        .ListRows.Add: ligne = 1
    Else: .ListRows.Add: ligne = .ListRows.Count

    End If
    With .DataBodyRange
        .Item(ligne, 1) = WorksheetFunction.Max(tb.ListColumns(1).Range) + 1
        .Item(ligne, 2) = Date
        .Item(ligne, 12) = Date + 90 'ou --> .Item(ligne, 2) + 90
        .Item(ligne, 16) = "Non"
        .Item(ligne, 17) = "Non"
    End With
End With

' Se placer sur la dernière cellule vide du tableau dans la colonne C
Range("C" & Rows.Count).End(xlUp).Offset(0, 0).Select

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

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

End Sub

Sub Annulation_des_filtres()

Set tbndo = ThisWorkbook.Sheets("Demandes outillages").ListObjects(1)
tbndo.AutoFilter.ShowAllData 'Annule tous les filtres automatiques du tableau "de la feuille Demandes outillages"

End Sub
Le 12/10/2023 à 10:11

Bonjour,

il faut plutôt que je trouve comment obliger un format de saisie des cellules dans la date du besoin du fichier demandes outillages.
st-ce qu'il est possible de faire cela sans macro par une fonction ou autre, ou bien peut-on plutôt mettre un calendrier qui apparaît lorsque l'on clique sur la cellule ?

Oui c'est possible sans macro en utilisant une liste de validation dans chaque cellule de la colonne qui vous impose d'entrer une date.
Sélectionnez la première cellule de votre tableau puis allez dans le menu Donnees et cliquez sur l'icone Liste de validation.
Cela vous donne ceci :

presse papier01

Une fois fait cochez la case "Appliquer ces modifications....." pour mettre cette validation sur toute votre colonne Date
Ensuite vous complétez le message de saisie (genre "mettre date au format jj/mm/yyyy") et l'alerte d'erreur (genre "ceci n'est pas une date")

En utilisation si vous placez une mauvaise date ou autre chose qu'une date "ADU ou ASAP", Excel vous enverra un message d'erreur

C'est une solution simple que j'avais d'ailleurs appliquée pour mon boulot et qui vous évite de compliquer en ajoutant des codes pour placer un calendrier utilisable dans chaque cellule.

NB : dans votre code nouvelle demande, remplacez

' Se placer sur la dernière cellule vide du tableau dans la colonne C
Range("C" & Rows.Count).End(xlUp).Offset(0, 0).Select

par

tb.DataBodyRange(tbDest.ListRows.Count, 1).Select
Le 12/10/2023 à 22:51

Bonsoir DAN,

Merci pour l'astuce, je n'avais pas pensé à cette solution qui est simple et qui répond totalement au besoin.

Encore un grand merci pour votre aide.
Cordialement
David
Rechercher des sujets similaires à "copier mise jour donnees tableau"