Copie de 2 fichiers en un seul

biddal

XLDnaute Nouveau
Bonjour,
J'ai 2 fichiers excel Perf1 et Perf2 bien différents dont le contenu est un simple tableau! Le même tableau dans les deux avec juste les valeurs à l'intérieur qui différent.

Ex:

Perf1:

Nom: Cooper: Marche course: 100+10m: Tir: Cordes: Abdos:

toto 2700 40 min 157 sec 90 17 sec 55

Perf2:

Nom: Cooper: Marche course: 100+10m: Tir: Cordes: Abdos:

titi 3200 36 min 221 sec 80 12 sec 55

Je voudrais donc faire un copier/coller grâce à une macro dans le 3ème fichier Rslt.

Le tableau serait le même mais je dois copier les 2 tableaux dans celui-ci mais sans écraser les valeurs qu'il pourrait déjà y avoir.

Actuellement j'ai ça: (je ne teste qu'avec un seul fichier pour la copie)

Code:
Sub Bouton1_QuandClic()

Dim LigneCopiageFin As Long
Dim LigneCollage As Long

Workbooks.Open Filename:="C:\Documents and Settings\bdu\Bureau\Excel_FSI\Perf1.xls"

LigneCopiageFin = Range("A65535").End(xlUp).Row
Range("A2:G" & LigneCopiageFin).Copy

[COLOR="Red"]Workbooks.Open Filename:="C:\Documents and Settings\bdu\Bureau\Excel_FSI\Rslt.xls"[/COLOR]

LigneCollage = Range("A65535").End(xlUp).Row
LigneCollage = LigneCollage + 1

Range("A" & LigneCollage).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False

End Sub

Le souci c'est que cela ne me fait rien du tout ! Si j'enlève la ligne que j'ai mis en rouge ça me fait bien la copie mais ça me la colle dans Perf1 et non dans Rslt !! Je ne gère pas encore le fait qu'il puisse y avoir déjà des données je veux d'abord faire fonctionner le copier/coller le reste je verai par la suite :p .
Je vous remercie par avance pour votre aide.
 

biddal

XLDnaute Nouveau
Re : Copie de 2 fichiers en un seul

Merci en fait j'ai trouvé ma solution ! Voici le code:

Code:
Sub Bouton1_QuandClic()

Dim LigneCopiageFin As Long
Dim LigneCollage As Long
Dim LigneCopiageFin2 As Long
Dim LigneCollage2 As Long

'Traitement du Fichier 1 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Workbooks.Open Filename:="C:\Documents and Settings\bdu\Bureau\Excel_FSI\Perf1.xls"

LigneCopiageFin = Range("A65535").End(xlUp).Row
Range("A2:G" & LigneCopiageFin).Copy

Windows("Rslt.xls").Activate

LigneCollage = Range("A65535").End(xlUp).Row
LigneCollage = LigneCollage + 1

Range("A" & LigneCollage).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
  
' Traitement du Fichier 2 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Workbooks.Open Filename:="C:\Documents and Settings\bdu\Bureau\Excel_FSI\Perf2.xls"

LigneCopiageFin2 = Range("A65535").End(xlUp).Row
Range("A2:G" & LigneCopiageFin2).Copy

Windows("Rslt.xls").Activate

LigneCollage2 = Range("A65535").End(xlUp).Row
LigneCollage2 = LigneCollage2 + 1

Range("A" & LigneCollage2).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 
' Fermeture des différents fichiers excel sauf celui de la macro '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim n As Integer

n = Workbooks.Count
MsgBox "Il y a " & n & " fichier(s) excel ouvert "
Do Until Workbooks.Count = 1
If Not Workbooks(n).Name = ActiveWorkbook.Name Then Workbooks(n).Close
Loop

C'est pas forcément ce qu'il y a de mieux mais j'ai réussi comme ça c'est le principal :p.
Bon je ne gère pas encore les doublons ça va venir. J'ai juste un souci avec la fermeture de mes fichiers à la fin !!
Il me compte le nombre de fichiers ouvert ici il y en a 3. Il me ferme bien le Perf2 mais pas le Perf1 ni Rslt! Pour Rslt c'est normal mais pour Perf1 non je ne vois pas ou est l'erreur !
Merci pour votre aide.
 
Dernière édition:

biddal

XLDnaute Nouveau
Re : Copie de 2 fichiers en un seul

J'ai trouvé ma réponse:

Code:
' Fermeture des différents fichiers excel sauf celui de la macro '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim n As Integer

n = Workbooks.Count
MsgBox "Il y a " & n & " fichier(s) excel ouvert "
Do Until Workbooks.Count = 1
If Not Workbooks(n).Name = ActiveWorkbook.Name Then Workbooks(n).Close
[COLOR="Red"]n=n-1[/COLOR]
Loop

Bon par contre je dois gérer les doublons maintenant si quelqu'un peut m'éclairer la dessus je ne sais pas du tout comment faire !!
Merci pour votre aide!
 

juliarca

XLDnaute Nouveau
Macro qui fonctionne sur un ordinateur mais pas sur un autre

Bonjour à tous,

j'ai un petit soucis avec une macro que j'ai réalisé dans un cadre professionnel.

En effet, sur mon ordinateur et sur celle d'un collègue, celle-ci fonctionne très bien, alors que sur 2 autres ordinateurs, elle ne fonctionne pas du tout.

Tout le monde possède les mêmes accés, et nous avons les mêmes séparateurs.

Quelqu'un peut-il me dire s'il a déjà rencontré ce problème et si oui, qu'a t-il fait pour y remédier.

Merci de votre réponse.
 

Discussions similaires

Statistiques des forums

Discussions
312 305
Messages
2 087 084
Membres
103 461
dernier inscrit
dams94