XL 2021 liaison entre deux tableaux

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

brunocean

XLDnaute Occasionnel
Supporter XLD
Bonsoir ,
J'ai un classeur avec un tableau que je rempli et ensuite je fais copier /déplacer , faire une copie dans un autre classeur pour donc les deux sont identique . est il possible de lier les deux pour que le tableau source se synchronise lorsque j'apporte une modification dans la copie??
 
Dernière édition:
Solution
J'ai amélioré la macro, dans le cas où le fichier sauvegardé est déjà ouvert on ne le ferme plus :
VB:
Private Sub Workbook_Activate()
Dim chemin$, w As Worksheet, wb As Workbook, ouvert As Boolean
chemin = Me.Path & "\Sauvegarde\" 'sous-dossier
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each w In Worksheets
    On Error Resume Next
    Set wb = Nothing: ouvert = False
    Set wb = Workbooks(w.Name & ".xlsx")
    If Err = 0 Then 'si le fichier est ouvert
        If wb.Saved Then 'et a été enregistré
            ouvert = True
        Else
            If MsgBox("Le fichier '" & w.Name & ".xlsx' est ouvert et a été modifié, voulez-vous enregistrer les modifications ?", vbYesNo +...
Téléchargez le dossier zip joint et extrayez son contenu sur le bureau.

Ouvrez le fichier tests.xlsm, cette macro dans ThisWorkbook s'exécute automatiquement :
VB:
Private Sub Workbook_Activate()
Dim chemin$, source As Worksheet, nf$
chemin = Me.Path & "\Sauvegarde\" 'sous-dossier
Set source = Sheets("BUDGET")
nf = source.Name
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
With Workbooks.Open(chemin & nf & ".xlsx") 'ouverture du fichier sauvegardé
    If Err Then
        MsgBox "Le fichier '" & chemin & nf & ".xlsx' est introuvable", 48
    Else
        .Sheets(nf).Cells.Copy source.Cells(1)
        If Err Then MsgBox "Le fichier '" & nf & ".xlsx' doit contenir une feuille '" & nf & "'", 48
        With source.Cells(1).MergeArea
            .Copy .Cells 'allège la mémoire
            .Merge 'refusionne si nécessaire
        End With
        .Close False 'fermeture du fichier sauvegardé
    End If
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Le fichier dans le sous-dossier "Sauvegarde" est copié vers la feuille source avec les modifications que vous y aurez faites.

A+
 

Pièces jointes

Téléchargez le dossier zip joint et extrayez son contenu sur le bureau.

Ouvrez le fichier tests.xlsm, cette macro dans ThisWorkbook s'exécute automatiquement :
VB:
Private Sub Workbook_Activate()
Dim chemin$, source As Worksheet, nf$
chemin = Me.Path & "\Sauvegarde\" 'sous-dossier
Set source = Sheets("BUDGET")
nf = source.Name
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
With Workbooks.Open(chemin & nf & ".xlsx") 'ouverture du fichier sauvegardé
    If Err Then
        MsgBox "Le fichier '" & chemin & nf & ".xlsx' est introuvable", 48
    Else
        .Sheets(nf).Cells.Copy source.Cells(1)
        If Err Then MsgBox "Le fichier '" & nf & ".xlsx' doit contenir une feuille '" & nf & "'", 48
        With source.Cells(1).MergeArea
            .Copy .Cells 'allège la mémoire
            .Merge 'refusionne si nécessaire
        End With
        .Close False 'fermeture du fichier sauvegardé
    End If
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Le fichier dans le sous-dossier "Sauvegarde" est copié vers la feuille source avec les modifications que vous y aurez faites.

A+
bonjour , je viens de voir votre proposition merci , mais cela ne correspond pas vraiment .
sur votre projet , je rempli dans la sauvegarde et cela rempli l'onglet budget .
Mais je ne pourrais pas créer d'autres onglets .
et ma demande c'est plutôt que je puisse créer plusieurs onglets dans le même classeurs , chacun de ses onglets sera dupliqué dans un dossier différent et donc ma demande est plutôt modifier ceux dans les dossiers et que cela complète l'original.
 
Bonjour brunocean, le forum,

J'ai repris le problème avec plusieurs fichiers sauvegardés.

Les noms des fichiers et les noms des feuilles sont les mêmes : dans ce cas la formule avec la fonction CELLULE ne fonctionne pas.

La macro dans le fichiers tests.xlsm :
VB:
Private Sub Workbook_Activate()
Dim chemin$, w As Worksheet
chemin = Me.Path & "\Sauvegarde\" 'sous-dossier
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each w In Worksheets
    On Error Resume Next
    With Workbooks.Open(chemin & w.Name & ".xlsx") 'ouverture du fichier sauvegardé s'il existe
        If Err = 0 Then
            .Sheets(1).Cells.Copy w.Cells(1)
            With w.Cells(1).MergeArea
                .Copy .Cells 'allège la mémoire
                .Merge 'refusionne si nécessaire
            End With
            .Close False 'fermeture du fichier sauvegardé
        End If
    End With
Next w
Application.EnableEvents = True 'réactive les évènements
End Sub
A+
 

Pièces jointes

Bon si vous tenez à une formule en H3 j'ai renommé les feuilles des fichiers sauvegardés et utilisé :
Code:
=SUBSTITUE(STXT(CELLULE("filename";A1);TROUVE("]";CELLULE("filename";A1))+1;99);"BUDGET ";"")
Merci pour votre aide, c'est le fonctionnement inverse mais je peux m'adapter . dommage impossible d'avoir une liste déroulante apparemment !!
lorsque je fait enregistrer cela ferme le classeur
 
J'ai amélioré la macro, dans le cas où le fichier sauvegardé est déjà ouvert on ne le ferme plus :
VB:
Private Sub Workbook_Activate()
Dim chemin$, w As Worksheet, wb As Workbook, ouvert As Boolean
chemin = Me.Path & "\Sauvegarde\" 'sous-dossier
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each w In Worksheets
    On Error Resume Next
    Set wb = Nothing: ouvert = False
    Set wb = Workbooks(w.Name & ".xlsx")
    If Err = 0 Then 'si le fichier est ouvert
        If wb.Saved Then 'et a été enregistré
            ouvert = True
        Else
            If MsgBox("Le fichier '" & w.Name & ".xlsx' est ouvert et a été modifié, voulez-vous enregistrer les modifications ?", vbYesNo + vbQuestion) = vbYes Then
                wb.Save 'enregistre le fichier
                ouvert = True
            Else
                wb.Close False 'ferme le fichier
            End If
        End If
    End If
    If Not ouvert Then Err = 0: Set wb = Workbooks.Open(chemin & w.Name & ".xlsx") 'ouverture du fichier sauvegardé
    If Err = 0 Then
        wb.Sheets(1).Cells.Copy w.Cells(1)
        With w.Cells(1).MergeArea
            .Copy .Cells 'allège la mémoire
            .Merge 'refusionne si nécessaire
        End With
        wb.Saved = True 'en effet la fonction CELLULE est volatile et a été recalculée
        If Not ouvert Then wb.Close 'ferme le fichier s'il n'était pas ouvert
    End If
Next w
Application.EnableEvents = True 'réactive les évènements
End Sub
C'est quand même plus compliqué à comprendre...
 

Pièces jointes

J'ai amélioré la macro, dans le cas où le fichier sauvegardé est déjà ouvert on ne le ferme plus :
VB:
Private Sub Workbook_Activate()
Dim chemin$, w As Worksheet, wb As Workbook, ouvert As Boolean
chemin = Me.Path & "\Sauvegarde\" 'sous-dossier
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each w In Worksheets
    On Error Resume Next
    Set wb = Nothing: ouvert = False
    Set wb = Workbooks(w.Name & ".xlsx")
    If Err = 0 Then 'si le fichier est ouvert
        If wb.Saved Then 'et a été enregistré
            ouvert = True
        Else
            If MsgBox("Le fichier '" & w.Name & ".xlsx' est ouvert et a été modifié, voulez-vous enregistrer les modifications ?", vbYesNo + vbQuestion) = vbYes Then
                wb.Save 'enregistre le fichier
                ouvert = True
            Else
                wb.Close False 'ferme le fichier
            End If
        End If
    End If
    If Not ouvert Then Err = 0: Set wb = Workbooks.Open(chemin & w.Name & ".xlsx") 'ouverture du fichier sauvegardé
    If Err = 0 Then
        wb.Sheets(1).Cells.Copy w.Cells(1)
        With w.Cells(1).MergeArea
            .Copy .Cells 'allège la mémoire
            .Merge 'refusionne si nécessaire
        End With
        wb.Saved = True 'en effet la fonction CELLULE est volatile et a été recalculée
        If Not ouvert Then wb.Close 'ferme le fichier s'il n'était pas ouvert
    End If
Next w
Application.EnableEvents = True 'réactive les évènements
End Sub
C'est quand même plus compliqué à comprendre...
bonsoir , la dernière version est bien plus agréable à utiliser. une petite question si je veux créer un dossier disons Henri , le mode opératoire a t'il une importance? faut il le créer a partir du classeur TEST et faire une copie d'un autre dossier que je renomme ou puis puis je créer le dossier henry dans SAUVEGARDE et après dans TEST??Dommage que les listes déroulante ne fonctionne pas
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
12
Affichages
360
Réponses
1
Affichages
189
Réponses
33
Affichages
1 K
Retour