Macro et deux fichiers Excel

ablinux · 9 Avril 2010

Bonjour à tous,

J'ai 2 problèmes à vous soumettre :

Le 1er :

J'ai deux fichiers, qui ont chacune plusieurs feuilles (pas forcement du même noms) composé de plusieurs champs (identiques dans les deux fichiers).

J'insère à chaque fois manuellement des données dans le 1er, et je dois tout le temps reprendre les mêmes process dans le second. Je voudrai avoir une macro qui une fois exécutée, parcours automatiquement le second fichier (donc toutes les feuilles), retrouve le champs correspondant et y insère la donnée.

Le 2ème:

Toujours 2 autres fichiers, mais je dois vérifier dans l'un si certaines données contenues dans l'autre s'y trouvent. Sinon, les créer (insérer les lignes qui y sont absentes).

J'espère avoir été assez clair sur le déroulement du process .

Merci de votre aide.

job75 · 12 Avril 2010

Re : Macro et deux fichiers Excel

Bonjour ablinux, bienvenue sur XLD,

C'est un peu tristounet pour un 1er message de ne pas avoir de réponse, alors je vous ai fait quelque chose, voir les 2 fichiers joints.

1) Tous les champs du 1er fichier sont nommés (onglet Formules-Gestionnaire de noms), et ceux du 2ème sont nommés avec les mêmes noms.

2) Dans ThisWorkbook (Alt+F11) du 1er fichier, cette macro :

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim fichdest As String, htablo As Long, n As Object, nom As String, plage As Range
fichdest = "Destination(1).xls" [COLOR="Red"]'nom à adapter[/COLOR]
htablo = 200 [COLOR="red"]'hauteur maximum des tableaux, à adapter[/COLOR]
Application.ScreenUpdating = False
On Error Resume Next
'---Ouverture du fichier s'il n'est pas ouvert---
If IsError(Workbooks(fichdest).Name) Then
  Err = 0
  Workbooks.Open ThisWorkbook.Path & "\" & fichdest 'si les 2 fichiers sont dans le même dossier
  If Err Then MsgBox "'" & fichdest & "' introuvable...": Exit Sub
End If
ThisWorkbook.Activate
'---Copie des champs---
For Each n In ThisWorkbook.Names
  nom = n.Name
  Set plage = Nothing 'sécurité...
  Set plage = Range(nom).Resize(htablo)
  If Not Intersect(Source, plage) Is Nothing Then
    Workbooks(fichdest).Activate
    Range(nom).Resize(htablo) = plage.Value
    ThisWorkbook.Activate
  End If
Next
Application.ScreenUpdating = True
End Sub

3) Au début du code, adaptez le nom du fichier et la hauteur maximum des tableaux.

4) Les 2 fichiers doivent être mis dans le même dossier (répertoire), par exemple le bureau.

Normalement ablinux, pour un problème de ce genre, vous auriez dû joindre un fichier, peut-être auriez-vous eu une solution moins lourde et mieux adaptée.

A+

job75 · 12 Avril 2010

Re : Macro et deux fichiers Excel

Re,

La macro précédente répercute les modifications du 1er fichier dans le 2ème.

Si on veut aussi qu'une modification du 2ème soit répercutée dans le 1er, il suffit de mettre la même macro dans le ThisWorkbook du 2ème (en adaptant bien sûr fichdest).

Mais dans les 2 macros, il faut alors désactiver l'action des évènements (code en rouge) :

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim fichdest As String, htablo As Long, n As Object, nom As String, plage As Range
fichdest = "Destination(1).xls" 'nom à adapter
htablo = 200 'hauteur maximum des tableaux, à adapter
Application.ScreenUpdating = False
On Error Resume Next
'---Ouverture du fichier s'il n'est pas ouvert---
If IsError(Workbooks(fichdest).Name) Then
  Err = 0
  Workbooks.Open ThisWorkbook.Path & "\" & fichdest 'si les 2 fichiers sont dans le même dossier
  If Err Then MsgBox "'" & fichdest & "' introuvable...": Exit Sub
End If
ThisWorkbook.Activate
'---Copie des champs---
[COLOR="Red"]Application.EnableEvents = False 'désactive l'action des évènements[/COLOR]
For Each n In ThisWorkbook.Names
  nom = n.Name
  Set plage = Nothing 'sécurité...
  Set plage = Range(nom).Resize(htablo)
  If Not Intersect(Source, plage) Is Nothing Then
    Workbooks(fichdest).Activate
    Range(nom).Resize(htablo) = plage.Value
    ThisWorkbook.Activate
  End If
Next
[COLOR="Red"]Application.EnableEvents = True 'active l'action des évènements[/COLOR]
Application.ScreenUpdating = True
End Sub

A+

job75 · 12 Avril 2010

Re : Macro et deux fichiers Excel

Re,

Encore une précision utile.

Si au début vous voulez mettre à jour tous les champs du 2ème fichier, passez en revue chaque feuille du 1er fichier :

- sélectionnez toutes les cellules (clic sur le carré en haut à gauche)

- clic droit => Copier

- clic droit => Coller.

Edit : on peut d'ailleurs faire cela en même temps sur toutes les feuilles :
clic droit sur un onglet => Sélectionner toutes les feuilles.

A+

ablinux · 12 Avril 2010

Re : Macro et deux fichiers Excel

Bonjour job75,

Merci pour toutes ces réponse, je vous joint quelques échantillons de fichiers :

Pour le 1er problème.

Merci d'avance.

ablinux · 12 Avril 2010

Re : Macro et deux fichiers Excel

Je vous enverrai un autre échantillon pour le second problème. C'est le 1er qui urge.

Merci 😉

job75 · 12 Avril 2010

Re : Macro et deux fichiers Excel

Re,

Tout ce que je vois c'est 3 feuilles avec 24 colonnes dont les en-têtes sont identiques.

Perso je n'hésiterais pas : je créerais 24 x 3= 72 noms pour appliquer la méthode que j'ai proposée. Mais là c'est à vous de travailler 🙂

Et combien de lignes maximum pouvez vous avoir (pour renseigner la variable htablo) ?

A priori, le 1er et le 2ème problèmes sont identiques : il s'agit de mettre à jour un fichier par rapport à un autre.

Tâchez de bien comprendre ce que fait la macro.

A+

ablinux · 12 Avril 2010

Re : Macro et deux fichiers Excel

Bonsoir,

Je viens d'adapter votre code, et ça donne à peu près ceci :

Code:

Sub Insert_Auto()
'
' Insert_Auto Macro
'

'
    Application.Goto Reference:="Insert_Auto"

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)

Dim fichdest As String, htablo As Long, n As Object, nom As String, plage As Range
fichdest = "Destination(1).xls" 'nom à adapter
htablo = 50000 'hauteur maximum des tableaux, à adapter
Application.ScreenUpdating = False

On Error Resume Next

'---Ouverture du fichier s'il n'est pas ouvert---

If IsError(Workbooks(fichdest).Name) Then
  Err = 0
  Workbooks.Open ThisWorkbook.Path & "\" & fichdest 'si les 2 fichiers sont dans le même dossier
  If Err Then MsgBox "'" & fichdest & "' introuvable...": Exit Sub
End If
ThisWorkbook.Activate

'---Copie des champs---

For Each n In ThisWorkbook.Names
  codepar = n.code_part
  part = n.Partenaires
  codeag = n.code_agences
  age = n.agences
  etat = n.code_etat_bons
  bon = n.etat_bons
  Nature = n.Code_Nature_ligne
  ligne = n.nature_ligne
  direct = n.Direction
  affect = n.affectation
  num = n.numero
  baill = n.bailleur
  numfact = n.Numero_Facture
  acompte = n.ACOMPTE_AVANCE
  Final = n.EXECUTION_FINAL
  cumul1 = n.CUMUL_REALISATION
  cumul2 = n.CUMUL_MONTANT
  budg = n.BUDGET
  sold = n.SOLDE
  compte = n.Comptes
  budg2 = n.budget_2010
  rub = n.Rubrique
  
  Set plage = Nothing 'sécurité...
  Set plage = Range(codepar).Resize(htablo)
  Set plage = Range(codeag).Resize(htablo)
  Set plage = Range(age).Resize(htablo)
  Set plage = Range(etat).Resize(htablo)
  Set plage = Range(bon).Resize(htablo)
  Set plage = Range(Nature).Resize(htablo)
  Set plage = Range(ligne).Resize(htablo)
  Set plage = Range(direct).Resize(htablo)
  Set plage = Range(affect).Resize(htablo)
  Set plage = Range(num).Resize(htablo)
  Set plage = Range(baill).Resize(htablo)
  Set plage = Range(numfact).Resize(htablo)
  Set plage = Range(acompte).Resize(htablo)
  Set plage = Range(Final).Resize(htablo)
  Set plage = Range(cumul1).Resize(htablo)
  Set plage = Range(cumul2).Resize(htablo)
  Set plage = Range(budg).Resize(htablo)
  Set plage = Range(sold).Resize(htablo)
  Set plage = Range(compte).Resize(htablo)
  Set plage = Range(budg2).Resize(htablo)
  Set plage = Range(rub).Resize(htablo)

If Not Intersect(Source, plage) Is Nothing Then
    Workbooks(fichdest).Activate
    Range(nom).Resize(htablo) = plage.Value
    ThisWorkbook.Activate
  End If
Next
Application.ScreenUpdating = True
End Sub

job75 · 13 Avril 2010

Re : Macro et deux fichiers Excel

Bonjour ablinux, le forum,

Pas compris votre "adaptation", je n'ai rien indiqué de tel 😉

Les champs doivent être définis dans les feuilles, pas en VBA.

Maintenant avec 50000 lignes à copier, ça risque d'être long !!!

A+

ablinux · 13 Avril 2010

Re : Macro et deux fichiers Excel

Bonjour job75,

Mais votre code ci

Code:

nom = n.Name
Set plage = Range(nom).Resize(htablo)

M'avait laisser de croire qu'il fallait indiquer tous les champs à ce niveau.

Une question : J'ai bien lu le code, mais je sais pas s'il tient en compte les autres fichiers dans le même répertoire?

Cdlt !

job75 · 13 Avril 2010

Re : Macro et deux fichiers Excel

Re,

Je me demande bien ce que vous fabriquez ablinux, vous filez du mauvais coton 😉

J'ai bien l'impression que vous n'avez même pas essayé les 2 fichiers de mon post # 2.

A+

Macro et deux fichiers Excel

ablinux

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

ablinux

XLDnaute Nouveau

Pièces jointes

ablinux

XLDnaute Nouveau

job75

XLDnaute Barbatruc

ablinux

XLDnaute Nouveau

job75

XLDnaute Barbatruc

ablinux

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Discussions similaires

Macro et deux fichiers Excel

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency