probleme de formulation dans un macro pour copier

[dj.run]

Bonjour le forum,

je viens vers vous, car je rencontre un probleme pour formuler une macro, je vais essayer d'être clair dans mes explications :

j'ai deux fichiers excels ( disons toto et tata), toto est fermé et tata est ouvert, ces fichiers ont un nombre d'onglets differents, mais ils ont des onglets en commun ( même nom) .

ce que je veux faire :

je voudrai ouvrir toto, comparer les nom des onglet de toto avec ceux de tata et pour les onglets qui ont le même nom, je voudrai copier les colonnes A, B, C, D, E, F, G du fichier toto vers les feuilles de même nom du fichier tata. puis refermer toto .

j'ai commencé une macro mais je rencontre des erreurs, un coup de main serait le bienvenu .

merci par avance à tous ceux qui pourront m'aider .

pour info le debut de ma macro (les fichiers ne s'appellent pas toto et tata)

Sub react()

Dim WS As Worksheet
Dim i As Integer

Workbooks.Open ThisWorkbook.Path & " \" & "echeancierdecade.xls"
For Each WS In Worksheets("echeancierdecade.xls")
If WS.Name = Worksheets("RECAP_FACTOREM.xls").WS.Name Then





end sub

merci encore .

@+dj.run

 

[michel]

Bonjour dj.run

j'espere le fichiers joint repondra à ta demande
( les deux classeurs doivent etre dans le meme repertoire dans l'exemple , j'ai mis des annotations dans la macro pour que tu puisses l'adapter à ton projet )

bonne soirée
Michel

 

[dj.run]

Bonjour le forum,

Super Michel ton exemple, c'est exactement ce que je voulais faire, mais quand je vois ton code, je me dis que j'aurait pu chercher longtemps.

il ne me reste plus qu'a adapter ton code à mon projet.

juste une petite question suplementaire,

est il possible avant de copier les valeurs du fichier ferme d'effacer les valeurs dans les feuilles du fichier ouvert ???

car si l'on lance la macro 2 fois, elle recopie les valeurs à la suite de celles deja en place dans les feuilles. et en faite ce que je veux faire c'est remplacer les valeurs existantes .


encore un GRAND MERCI Michel .

@+dj.run

 

[michel]

bonjour dj.run

ci dessous la nouvelle version qui efface les anciennes valeurs du claseur ouvert avant le transfert des valeurs .


Option Explicit

Sub RecupInfosV02()
Dim Sh As Worksheet
Dim i As Byte
Dim j As Byte

Application.ScreenUpdating = False ' figer l'écran
Application.DisplayAlerts = False ' désactiver les messages d'alertes eventuels

Workbooks.Open ThisWorkbook.Path & "\classeur ferme.xls" ' adapter selon localisation fichier à ouvrir

For i = 1 To ThisWorkbook.Sheets.Count ' boucle sur le nb de feuille de ce classeur
ThisWorkbook.Sheets(i).Cells.Clear ' effacer les anciennes valeurs du classeur ouvert
For Each Sh In ActiveWorkbook.Sheets ' boucle sur les feuille du fichier à analyser
If ThisWorkbook.Sheets(i).Name = Sh.Name Then
Sh.Range("A1:G" & Sh.Range("G65536").End(xlUp).Row).Copy ' COPIER à adapter selon fichier cible
ThisWorkbook.Sheets(i).Range("A1").PasteSpecial ' COLLER à adapter selon fichier cible
End If
Next Sh
Next i

Workbooks("classeur ferme.xls").Close SaveChanges:=False 'fermer sans modification du classeur
ThisWorkbook.Sheets(1).Activate
Application.DisplayAlerts = True ' ne pas oublier de réactiver les messages d'alerte !
Application.ScreenUpdating = True
Application.CutCopyMode = False 'désactiver collage

End Sub


bon début de week end
Michel

 

[michel]

Bonjour dj.run

j'ai oublié le principal ....


Bon anniversaire !



....si les infos de l'annuaire des membres sont à jour ....
en tout cas , au vu de la photo tu ne fais pas ton age ...;o)

bonne journée
Michel

 

[dj.run]

Bonjour le Forum, bonjour Michel,

Super, super, grace à toi je viens de finir mon projet pour mon Bos, j'ai reussi à adapter ta programmation et ça fonctionne tres bien, le seul petit probleme c'est que c'est un peu lent mais on ne peut rien y faire car il y à beaucoup de calcul qui se font apres la mise à jour de mon fichier .

merci aussi pour l'anniversaire et pour le cadeau (ta macro).

à bientôt, je ne sais pas si je pourrai te renvoyer l'ascenseur, on sait jamais....


@+ dj.run