Discussion :

[retraite83]

Bonjour,

je veux copier le contenu d'une feuille d'un classeur d'un dossier "D1" dans la feuille de même nom d'un classeur de même nom présent dans un dossier "D2"

Je me suis débrouillé en passant par la copie du classeur du dossier "D1" en un classeur temporaire pour ne pas avoir 2 classeurs de même nom ouvert en même temps mais il doit y avoir une solution plus "élégante" et moins lourde

J'ai pensé au presse papier (?) mais je ne vois pas si cela est possible et comment

Ou autre solution

[MarcelG]

Bonjour Retraite83

Une possibilité: dans un classeur tiers, considérer une variable tableau gérant la liaison entre 2 tableaux structurés appartenant à 2 classeurs de même nom.

Ici, le tableau structuré du 2ème classeur débute en A1

J'ai intégré des commentaires.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Option Explicit
 
Public Sub Copy_mêmenom()
 
Dim T() As Variant
 
Dim wkb1 As Workbook, wkb2 As Workbook
 
'Ouverture Classeur 1
Workbooks.Open Filename:= _
        "le_premier_répertoire\Classeur_discussion.xlsm"
 
Set wkb1 = ActiveWorkbook
'La variable Tableau est alimentée par le DataBodyrange du tableau structuré T_Base
T = wkb1.Worksheets(1).Range("T_Base").Value
 
'Fermeture Classeur 1 sans enregistrement
wkb1.Close Savechanges:=False
 
'Variable libérée
Set wkb1 = Nothing
 
'Ouverture Classeur 2
Workbooks.Open Filename:= _
        "le_second_répertoire\Classeur_discussion.xlsm"
Set wkb2 = ActiveWorkbook
 
With wkb2
 
        With .Worksheets(1)
                'Tableau structuré T_Base vidé
                .Range("T_Base").ListObject.DataBodyRange.Delete
                'Alimentation des données par la variable Tableau
                .Range("A2").Resize(UBound(T, 1), UBound(T, 2)).Value = T
        End With
 
        'Fermeture Classeur 2 avec enregistrement
        .Close Savechanges:=True
 
End With
 
'Variable libérée
Set wkb2 = Nothing
 
End Sub

Eventuellement à adapter