Superposition de tableaux

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion cevic
  • Date de début Date de début

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 !

S'inscrire
C

cevic

Guest
Bonsoir,

j'ai 2 tableaux excel intitulés respectivement inventaire source et inventaire modele,

le source comprend plus de donnée que le modèle, je voudrais réunir ces 2 tableaux en un seul avec les données des 2 et supprimer les doublons.

dans l'attente et avec mes remerciements anticipés

cordialement
 

Pièces jointes

Trier par date Trier par votes
Re : Superposition de tableaux

Bonjour,

Voyez le fichier .xls joint avec cette macro dans Module1 :

Code: 
Sub Fusion()
'Attention : le fichier de la feuille F2 doit être ouvert
Dim F1 As Worksheet, F2 As Worksheet, d As Object, c As Range, sup As Range
Set F1 = ThisWorkbook.Sheets("PISTOR SPUR BIODIS - Table 1")
Set F2 = Workbooks("INVENTAIRE SOURCE TEST.xlsx").Sheets("PISTOR-SPUR")
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Fusion")
  .Cells.Clear
  F1.UsedRange.EntireRow.Copy .[A1]
  F2.UsedRange.EntireRow.Copy .Cells(F1.UsedRange.Rows.Count + 1, 1)
  Set d = CreateObject("Scripting.dictionary")
  For Each c In Intersect(.[A:A], .UsedRange)
    If c = "" Or d.Exists(c.Value) Then _
      Set sup = Union(c, IIf(sup Is Nothing, c, sup))
    d(c.Value) = ""
  Next
  If Not sup Is Nothing Then sup.EntireRow.Delete
  .Columns.AutoFit 'ajustement automatique
End With
End Sub
Le fichier .xlsx doit être ouvert.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Superposition de tableaux

Bonjour Bébére, Bonjour Job 75

et merci pour vos réponses, concernant la macro proposée par Job75 je ne sais pas par ou commencer monniveau doit etre insuffisant, je vais quant meme essayer!

Bébére,

j'aimerai que mes 2 classeurs ne fassent qu'un en respectant les onglets, il y a des données dans l'un et pas dans l'autre et vice versa,

j'espère etre plus claire ?

merci de votre aide

cevic
 
Vote positif 0 Vote négatif
Re : Superposition de tableaux

Bonjour cevic, le fil, le forum,

S'il s'agit simplement de créer un fichier contenant les feuilles des 2 fichiers :

Code: 
Sub Fusion()
Dim chemin$, Wb As Workbook, w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
chemin = ThisWorkbook.Path & "\"
'---ouvre le 2ème fichier---
Set Wb = Workbooks.Open(chemin & "INVENTAIRE SOURCE TEST.xlsx")
With ThisWorkbook
  '---enregistre sous .xlsx---
  .SaveAs chemin & "Fusion.xlsx", 51
  '---ajoute les feuilles du 2ème fichier---
  For Each w In Wb.Worksheets
    w.Copy After:=.Sheets(.Sheets.Count)
  Next
  .Sheets(1).Delete
  .Save
  '---fermeture des fichiers---
  Wb.Close
  If Workbooks.Count = 1 Then Application.Quit Else .Close
End With
End Sub
Télechargez les 2 fichiers joints dans le même répertoire (par exemple le bureau).

La macro est dans le Module1 du fichier .xls.

Le fichier créé se nomme Fusion.xlsx et ne contient donc plus de macro.

Edit : eh non ça ne marche toujours pas sur Excel 2010...

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Superposition de tableaux

Re,

Là j'ai tout fait sur Excel 2010 et ça fonctionne très bien, mais c'est un peu compliqué :

Code: 
Sub Fusion_Etape1()
Dim chemin$, fichier$, fich$
chemin = ThisWorkbook.Path & "\"
fichier = "Fusion.xlsx"
fich = ThisWorkbook.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.SaveAs chemin & fichier, 51
Workbooks.Open chemin & fich
Application.Run "'" & fich & "'!Lance"
ThisWorkbook.Close
End Sub

Sub Lance()
Application.OnTime Now, "Fusion_Etape2"
End Sub

Sub Fusion_Etape2()
Dim chemin$, fichier$, n1%, Wb As Workbook, n2%, n%
chemin = ThisWorkbook.Path & "\"
fichier = "Fusion.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---ouvre le 1er fichier---
Workbooks.Open chemin & fichier
n1 = ThisWorkbook.Sheets.Count
'---ouvre le 2ème fichier---
Set Wb = Workbooks.Open(chemin & "INVENTAIRE SOURCE TEST.xlsx")
n2 = Wb.Sheets.Count
'---ajoute les feuilles du 2ème fichier dans le 1er---
With Workbooks(fichier)
  For n = 1 To n2
    Wb.Sheets(n).Copy After:=.Sheets(.Sheets.Count)
  Next
  .Sheets("Fusion des fichiers").Delete
  n = .Sheets.Count
  '---fermeture des fichiers---
  .Close True
  Wb.Close
End With
Application.ScreenUpdating = True
'---test de vérification---
If n = n1 + n2 - 1 Then MsgBox "Fusion réussie, voyez le fichier '" & fichier & "'..."
End Sub
On peut vérifier en mettant des valeurs après la colonne IV ou après la ligne 65536 du fichier .xlsx.

On les retrouvera bien dans le fichier Fusion.xlsx.

Fichiers joints, à télécharger sur le bureau pour tester.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Superposition de tableaux

Merci beaucoup, mais c'est en effet un peu compliqué!

dois je faire un copier/coller de votre macro? ou dois je la faire?
je vais essayer de pas être trop gourdasse mais là suis quand meme larguée.
 
Vote positif 0 Vote négatif
Re : Superposition de tableaux

Bonjour cevic, le forum,

Avec la version (2) du post #8 regardez bien le fichier Fusion.xlsx créé.

La copie des feuilles du 2ème fichier a créé des liaisons avec le fichier source.

Par exemple en cellules D11 D13 D15... de la feuille "variation stock".

Il est facile de modifier (donc de supprimer) ces liaisons :

Code: 
'---modification des liens---
.ChangeLink chemin & Wb.Name, fichier
Version (3) jointe.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Superposition de tableaux

Re,

Les doublons dans les noms des onglets ne posent pas de problème.

Si l'on veut les mettre en évidence il faut trier les onglets du fichier Fusion.xlsx créé :

Code: 
'---tri alphabétique des onglets---
  For p = 1 To n
    For q = p + 1 To n
      If .Sheets(q).Name < .Sheets(p).Name Then .Sheets(q).Move Before:=.Sheets(p)
    Next q
  Next p
  .Sheets(1).Activate
Version (4).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Superposition de tableaux

Re,

Maintenant si l'on ne veut pas de doublons de feuille :

Code: 
'---suppression des feuilles du 2ème fichier faisant doublon---
  For p = Wb.Sheets.Count To 1 Step -1
    For q = 1 To n1
      If UCase(Wb.Sheets(p).Name) = UCase(.Sheets(q).Name) _
        Then Wb.Sheets(p).Delete
    Next q
  Next p
  n2 = Wb.Sheets.Count
Version (5), je pense qu'on a fait le tour de la question.

Sauf à vérifier que les feuilles doublons contiennent la même chose, mais là ce serait du vice 🙄

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Superposition de tableaux

Bonsoir cevic,

Le temps portant conseil, voici une version (6) avec une seule macro.

Il suffit de 2 .SaveAs successifs :

Code: 
Sub Fusion()
Dim chemin$, fichier$, fich$, fichformat%, n1%, Wb As Workbook, p%, q%, n2%, n%
chemin = ThisWorkbook.Path & "\"
fichier = "Fusion.xlsx"
fich = ThisWorkbook.Name
fichformat = ThisWorkbook.FileFormat
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.SaveAs chemin & fichier, 51
ThisWorkbook.SaveAs chemin & fich, fichformat '56 ou 52
'---rouvre le fichier Fusion---
Workbooks.Open chemin & fichier
n1 = ThisWorkbook.Sheets.Count
'---ouvre le 2ème fichier---
Set Wb = Workbooks.Open(chemin & "INVENTAIRE SOURCE TEST.xlsx")
With Workbooks(fichier)
  '---suppression des feuilles du 2ème fichier faisant doublon---
  For p = Wb.Sheets.Count To 1 Step -1
    For q = 1 To n1
      If UCase(Wb.Sheets(p).Name) = UCase(.Sheets(q).Name) _
        Then Wb.Sheets(p).Delete
    Next q
  Next p
  n2 = Wb.Sheets.Count
  '---ajoute les feuilles du 2ème fichier dans le 1er---
  For n = 1 To n2
    Wb.Sheets(n).Copy After:=.Sheets(.Sheets.Count)
  Next n
  .Sheets("Fusion des fichiers").Delete
  n = .Sheets.Count
  '---modification des liens---
  .ChangeLink chemin & Wb.Name, fichier
  '---tri alphabétique des onglets---
  For p = 1 To n
    For q = p + 1 To n
      If .Sheets(q).Name < .Sheets(p).Name Then .Sheets(q).Move Before:=.Sheets(p)
    Next q
  Next p
  .Sheets(1).Activate
  '---fermeture des fichiers---
  .Close True
  Wb.Close False
End With
Application.ScreenUpdating = True
'---test de vérification---
If n = n1 + n2 - 1 Then MsgBox "Fusion réussie, voyez le fichier '" & fichier & "'..."
End Sub
Bien entendu supprimez les lignes (suppression des doublons, tri des onglets) qui ne vous intéressent pas.

Edit : avec la variable fichformat le 1er fichier peut être au format .xls (56) ou .xlsm (52).

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Superposition de tableaux

Merci beaucoup de toutes ces reponses et désolée d'avoir gardé le silence.

en fait je ne peux malheureusement pas avancer comme je le voudrai, mas je vous remercie de m'aider.

je mets des a present en pratique vos macros

tres belle journee

cecile
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

L
  • Question Question
XL 2021 [Power Query] Appliquer un nettoyage identique sur plusieurs tableaux d'une même documentation
Réponses
1
Affichages
196
chris
chris
L
  • Résolu(e)
Microsoft 365 Tableaux emboités
2
Réponses
15
Affichages
283
nullosse
N
P
  • Résolu(e)
Microsoft 365 Comparaison 2 tableaux EXCEL différents
Réponses
12
Affichages
802
Peter DOE
P
D
  • Question Question
Microsoft 365 Recherche X sur deux tableaux Excel différents
Réponses
6
Affichages
489
Daniel200666
D
F
  • Question Question
Autres problème de cache de TCD menant à des données partielles
2
Réponses
20
Affichages
686
chris
chris
Titof06
  • Résolu(e)
XL 2019 Augmenter la vitesse de traitement
2 3
Réponses
37
Affichages
1 K
dysorthographie
dysorthographie
K
  • Question Question
Microsoft 365 Gestion de certificat
Réponses
1
Affichages
174
Piment
P
F
  • Question Question
XL 2016 tableaux xl
Réponses
12
Affichages
452
TooFatBoy
TooFatBoy
F
  • Résolu(e)
XL 2021 problème de mise a jour besoin d'aide merci
Réponses
12
Affichages
416
fanch55
fanch55
patricktoulon
  • Résolu(e)
Autres chalenge vba
2 3
Réponses
32
Affichages
1 K
alexga78
A
N
  • Résolu(e)
Microsoft 365 Regroupement de quantité et longueur VBA ou Power Query
2
Réponses
25
Affichages
1 K
job75
job75
S
  • Résolu(e)
Microsoft 365 Affecter un numéro selon une condition
Réponses
7
Affichages
332
Sissou71
S
oguruma
POWERQUERY :: Combinaison de tableaux structurés Excel issus de dossiers différents permettant de fusionner soit des Table soit des Sheet -
Réponses
0
Affichages
193
oguruma
oguruma
B
  • Question Question
Microsoft 365 Faire la somme de plusieurs tableaux
2
Réponses
17
Affichages
2 K
AtTheOne
AtTheOne
M
  • Résolu(e)
XL 2021 Tableaux successifs avec colonnes de largeur différente
Réponses
2
Affichages
277
MATLEA
M
F
  • Question Question
XL 2016 recherche données et collage
Réponses
4
Affichages
229
finarobert
F
N
  • Question Question
Listbox click
Réponses
10
Affichages
664
ChTi160
ChTi160
MBax
  • Résolu(e)
Microsoft 365 Extraction d'informations sur différents onglets en partant d'une base de données
Réponses
7
Affichages
831
MBax
MBax
M
  • Question Question
Microsoft 365 Creation de champs de saisi pour l'inscritiption et le paiement de la scolarite
Réponses
8
Affichages
483
Dranreb
Dranreb
3
  • Question Question
XL 2013 Recherche a plusieurs critéres
Réponses
3
Affichages
531
sousou
sousou
Retour