Automatiser 3 fichiers Excel

[stagiairem]

Bonjour à tous,

J'aimerai savoir s'il y a possibilité d'automatiser 3 fichiers excel , c'est a dire que je possède un fichier source et de ce fichier, je prends certaines informations pour mes 2 autres fichiers qui ont des destinataires differents.

Cependant tous mes fichiers sont liés , il y a donc certains copier coller qui sont fait etc, je voudrais savoir s'il y a possibilité d'automatiser le fichier source et les deux autres fichiers, de sorte que lorsque j'ecris dans mon ficheir sources , les deux autres fichiers travails aussi, ainsi je n'ai plus besoin de copier coller etc.

Par exemple dans mes 3 fichiers la colonne A est la même, y 'a til possibilité de pouvoir juste ecrire dans l'un de mes fichier et sa MAJ les deux autres fichiers. etc.

Dite moi ce qui est possible? j'ai du temps ( je suis stagiaire).

Si vous connaissez des tutoriels adequats, n'hesitez pas.

Dans le cas ou ce serait impossible , dite moi si vous connaissez des logiciels capable de realiser cela ( type ACCES).

Cordialement.

 

[gosselien]

Re : Automatiser 3 fichiers Excel

Bonjour à toi,

tu devrais, comme c'est vivement conseillé, faire un petit exemple clair et l'envoyer ici

P.

 

[stagiairem]

Re : Automatiser 3 fichiers Excel

Bonjour gosselien,

Voici un exemple, il y a 3 fichiers, ces 3 fichiers sont liés dans la mesure ou il y a des colonnes similaires etc,

Ce que je cherche a savoir, est-il possible d'automatiser les 3 fichiers ? ,

Par exemple la colonne statut apparait dans les 3 fichiers, peut-on automatiser de sorte que lorsque l'on change le statut d'un nom dans le dossier cela modifie la colonne statut dans les deux autres fichiers ?

Deuxiemement, peut on autamiser de sorte à éviter les copier coller, des macros qui permette de faire le liens avec les colonnes existante entre dossier 1 et 2, dossier 2 et 3 et dossier 1 et 3 ?

Si tu as des tutoriels etc, n'hesite pas , j'ai beaucoups de temps et si cela est possible, j'y arriverai.

Cordialement.

PS: j'ai rajouté les 3 dossiers en exemple

 

[gosselien]

Re : Automatiser 3 fichiers Excel

re,

comme ceci alors ?

P.

 

[job75]

Re : Automatiser 3 fichiers Excel

Bonjour stagiairem, gosselien,

Ce code est à placer dans le ThisWorkbook (Alt+F11) des 3 fichiers joints :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a, nomfeuil$, fich, wb As Workbook, ncol%
Dim i&, nom$, lig As Variant, j%, col As Variant
Application.ScreenUpdating = False
a = Array("Dossier1exo.xlsm", "Dossier2exo.xlsm", "Dossier3exo.xlsm") 'à adapter
nomfeuil = "Feuil1" 'nom commun à toutes les feuilles, à adapter

'---ouverture des fichiers s'ils ne sont pas ouverts---
On Error Resume Next
For Each fich In a
  Set wb = Nothing
  Set wb = Workbooks(fich)
  If fich <> Me.Name And wb Is Nothing Then _
    Workbooks.Open Me.Path & "\" & fich
Next fich
On Error GoTo 0
Me.Sheets(nomfeuil).Activate

'---transfert des données---
ncol = ActiveSheet.UsedRange.Columns.Count
For i = 2 To ActiveSheet.UsedRange.Rows.Count
  nom = Cells(i, 1)
  For Each fich In a
    With Workbooks(fich).Sheets(nomfeuil)
      lig = Application.Match(nom, .Columns(1), 0)
      If IsError(lig) Then lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
      .Cells(lig, "Z") = "x" 'repère en colonne Z
      For j = 1 To ncol
        col = Application.Match(Cells(1, j), .Rows(1), 0)
        If IsNumeric(col) Then If .Cells(lig, col) <> Cells(i, j) _
          Then .Cells(lig, col) = Cells(i, j)
      Next j
    End With
  Next fich
Next i

For Each fich In a
  '---suppression des lignes non repérées---
  With Workbooks(fich).Sheets(nomfeuil)
    .Cells(1, "Z") = "x"
    .Columns("A:Z").Sort .Columns("Z") 'tri pour accélérer
    With .Columns("Z")
      On Error Resume Next
      .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      On Error GoTo 0
      .Delete
    End With
  End With
  '---enregistrement et fermeture---
  Application.EnableEvents = False
  If fich <> Me.Name Then Workbooks(fich).Close True
  Application.EnableEvents = True
Next fich
End Sub

La macro s'exécute quand on enregistre le fichier.

Tous les fichiers à traiter doivent être dans le même dossier (répertoire).

Si en colonne A il y a des doublons ou des cellules vides, les lignes sont supprimées.

Le traitement peut être assez long si les tableaux sont grands.

A+

 

[job75]

Re : Automatiser 3 fichiers Excel

Re,

Deux améliorations importantes dans les fichiers (2) joints :

1) Cancel = True évite l'utilisation de la commande "Enregistrer sous"

2) les huméros des colonnes à traiter sont mémorisés dans la matrice colonnes.

Cela évite Application.Match dans la boucle j et fait donc gagner du temps.

La nouvelle macro :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a, nomfeuil$, uba%, ncol%, colonnes(), f%, wb As Workbook, col As Variant
Dim i&, nom$, lig As Variant, j%
Cancel = True 'évite "Enregistrer sous"
Application.ScreenUpdating = False
a = Array("Dossier1exo.xlsm", "Dossier2exo.xlsm", "Dossier3exo.xlsm") 'à adapter
nomfeuil = "Feuil1" 'nom commun à toutes les feuilles, à adapter
uba = UBound(a)
ncol = ActiveSheet.UsedRange.Columns.Count
ReDim colonnes(1 To uba + 1, 1 To ncol) 'base 1, matrice de mémorisation des colonnes

'---ouverture des fichiers s'ils ne sont pas ouverts---
On Error Resume Next
For f = 0 To uba
  Set wb = Nothing
  Set wb = Workbooks(a(f))
  If a(f) <> Me.Name And wb Is Nothing Then Workbooks.Open Me.Path & "\" & a(f)
  Me.Sheets(nomfeuil).Activate
  With Workbooks(a(f)).Sheets(nomfeuil)
    .ShowAllData 'en cas de filtrage
    For col = 1 To ncol
      colonnes(f + 1, col) = Application.Match(Cells(1, col), .Rows(1), 0)
    Next
  End With
Next f
On Error GoTo 0

'---transfert des données---
For i = 2 To ActiveSheet.UsedRange.Rows.Count
  nom = Cells(i, 1)
  If nom <> "" Then
    For f = 0 To uba
      With Workbooks(a(f)).Sheets(nomfeuil)
        lig = Application.Match(nom, .Columns(1), 0)
        If IsError(lig) Then lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lig, "Z") = "x" 'repère en colonne Z
        For j = 1 To ncol
          col = colonnes(f + 1, j)
          If IsNumeric(col) Then If .Cells(lig, col) <> Cells(i, j) _
            Then .Cells(lig, col) = Cells(i, j)
        Next j
      End With
    Next f
  End If
Next i

For f = 0 To uba
  '---suppression des lignes non repérées---
  With Workbooks(a(f)).Sheets(nomfeuil)
    .Cells(1, "Z") = "x"
    .Columns("A:Z").Sort .Columns("Z") 'tri pour accélérer
    With .Columns("Z")
      On Error Resume Next
      .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      On Error GoTo 0
      .Delete
    End With
  End With
  '---enregistrement et fermeture---
  Application.EnableEvents = False
  Workbooks(a(f)).Save
  If a(f) <> Me.Name Then Workbooks(a(f)).Close
  Application.EnableEvents = True
Next f
End Sub

Edit : j'ai aussi ajouté .ShowAllData et le test If nom <> "" Then

Bonne fin de soirée.

 

[job75]

Re : Automatiser 3 fichiers Excel

Bonjour stagiairem, le forum,

Au lieu de mettre les repères "x" en colonne Z il vaut mieux les mettre dans la colonne qui suit la dernière colonne.

Le numéro de cette colonne est lui aussi stocké dans la matrice colonnes :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a, nomfeuil$, uba%, ncol%, colonnes(), f%, wb As Workbook, col As Variant
Dim i&, nom$, lig As Variant, j%
Cancel = True 'évite "Enregistrer sous"
Application.ScreenUpdating = False
a = Array("Dossier1exo.xlsm", "Dossier2exo.xlsm", "Dossier3exo.xlsm") 'à adapter
nomfeuil = "Feuil1" 'nom commun à toutes les feuilles, à adapter
uba = UBound(a)
ncol = ActiveSheet.UsedRange.Columns.Count
ReDim colonnes(1 To uba + 1, 1 To ncol + 1) 'matrice de mémorisation des colonnes

'---ouverture des fichiers s'ils ne sont pas ouverts---
On Error Resume Next
For f = 0 To uba
  Set wb = Nothing
  Set wb = Workbooks(a(f))
  If wb Is Nothing Then Workbooks.Open Me.Path & "\" & a(f)
  Me.Sheets(nomfeuil).Activate
  With Workbooks(a(f)).Sheets(nomfeuil)
    .ShowAllData 'en cas de filtrage
    For col = 1 To ncol
      colonnes(f + 1, col) = Application.Match(Cells(1, col), .Rows(1), 0)
    Next
    colonnes(f + 1, ncol + 1) = .UsedRange.Columns.Count + 1
  End With
Next f
On Error GoTo 0

'---transfert des données---
For i = 2 To ActiveSheet.UsedRange.Rows.Count
  nom = Cells(i, 1)
  If nom <> "" Then
    For f = 0 To uba
      With Workbooks(a(f)).Sheets(nomfeuil)
        lig = Application.Match(nom, .Columns(1), 0)
        If IsError(lig) Then lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lig, colonnes(f + 1, ncol + 1)) = "x" 'repère
        For j = 1 To ncol
          col = colonnes(f + 1, j)
          If IsNumeric(col) Then If .Cells(lig, col) <> Cells(i, j) _
            Then .Cells(lig, col) = Cells(i, j)
        Next j
      End With
    Next f
  End If
Next i

For f = 0 To uba
  '---suppression des lignes non repérées---
  With Workbooks(a(f)).Sheets(nomfeuil).Columns(colonnes(f + 1, ncol + 1))
    .Cells(1) = "x"
    .Parent.Range("A1", .Cells).Sort .Cells 'tri pour accélérer
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    .Delete
  End With
  '---enregistrement et fermeture---
  Application.EnableEvents = False
  Workbooks(a(f)).Save
  If a(f) <> Me.Name Then Workbooks(a(f)).Close
  Application.EnableEvents = True
Next f
End Sub

Fichiers (3).

Bonne journée.

 

[stagiairem]

Re : Automatiser 3 fichiers Excel

Merci job75 et gosselien

C'est un boulot fantastique que vous avez réalisé la.

J’espère que cela ne t'as pas pris trop temps, sinon en MP pour une compensation financière.


Merci beaucoup

 

[job75]

Re : Automatiser 3 fichiers Excel

Re,

Un détail : le test a(f) <> Me.Name était inutile à l'ouverture, je l'ai supprimé des fichiers (3).

J’espère que cela ne t'as pas pris trop temps, sinon en MP pour une compensation financière.

Sur XLD les contributeurs (bénévoles) ne se font généralement pas rémunérer, mais c'est sympa de le proposer.

Bonne continuation.

 

[job75]

Re : Automatiser 3 fichiers Excel

Re,

J'ai testé les 3 solutions avec 5000 lignes (pas de doublons dans les noms).

Contrairement à ce que je pensais l'utilisation de la matrice colonnes ne change pas grand-chose :

- fichiers (1) et fichiers (2) => 14 secondes environ

- fichers (3) => 13 secondes.

A+

 

[job75]

Re : Automatiser 3 fichiers Excel

Bonjour stagiairem,

Voici une méthode bien meilleure car bien plus rapide.

Elle utilise des tableaux VBA (matrices) et l'objet Dictionary :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a, nomfeuil$, t, d As Object, i&, b, c, fich, wb As Workbook
Dim t1, ncol%, tablo(), colonnes(), j%, lig&, lig1&, col As Variant
Cancel = True 'évite "Enregistrer sous"
Application.ScreenUpdating = False
a = Array("Dossier1exo.xlsm", "Dossier2exo.xlsm", "Dossier3exo.xlsm") 'à adapter
nomfeuil = "Feuil1" 'nom commun à toutes les feuilles, à adapter
t = Me.Sheets(nomfeuil).UsedRange.Offset(1) 'matrice, plus rapide
'---1ère liste des noms sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(t)
  If t(i, 1) <> "" Then d(t(i, 1)) = i 'mémorisation de la ligne
Next
If d.Count Then b = d.keys: c = d.items

For Each fich In a
  '---ouverture du fichier s'il n'est pas ouvert---
  Set wb = Nothing
  On Error Resume Next
  Set wb = Workbooks(fich)
  If wb Is Nothing Then Workbooks.Open Me.Path & "\" & fich
  Me.Sheets(nomfeuil).Activate
  With Workbooks(fich).Sheets(nomfeuil)
    '---préparation---
    .ShowAllData 'en cas de filtrage
    On Error GoTo 0
    t1 = .UsedRange.Offset(1) 'matrice, plus rapide
    ncol = UBound(t1, 2)
    ReDim tablo(1 To Application.Max(UBound(t), UBound(t1)), 1 To ncol)
    If d.Count = 0 Then GoTo 1 'si tableau vide
    ReDim colonnes(1 To ncol) 'mémorisation des colonnes à traiter
    For j = 1 To ncol
      colonnes(j) = Application.Match(.Cells(1, j), Rows(1), 0)
    Next j
    '---2ème liste des noms sans doublon---
    d.RemoveAll
    For i = 1 To UBound(t1)
      d(t1(i, 1)) = i
    Next i
    '---transfert des données de t et t1 dans tablo---
    For i = 0 To UBound(b)
      lig = c(i): lig1 = d(b(i))
      For j = 1 To ncol
        col = colonnes(j)
        If IsNumeric(col) Then tablo(i + 1, j) = t(lig, col) _
          Else If lig1 Then tablo(i + 1, j) = t1(lig1, j)
      Next j
    Next i
    '---restitution, enregistrement et fermeture---
1   Application.EnableEvents = False
    .[A2].Resize(UBound(tablo), ncol) = tablo
    .Parent.Save
    If fich <> Me.Name Then .Parent.Close
    Application.EnableEvents = True
  End With
Next fich
End Sub

Edit : ajouté les variables lig et lig1.

Fichiers (4).

Sur 5000 lignes le traitement se fait en 2,2 secondes.

Le traitement des tableaux et leur restitution dans les feuilles ne prend que 0,3 seconde, le reste du temps étant pris par l'ouverture, l'enregistrement et la fermeture des fichiers.

Il ne me paraît pas possible de faire mieux, sauf peut-être une solution utilisant la méthode ADO qui évite d'ouvrir les fichiers.

Il n'y aurait plus d'ouverture, enregistrement, fermeture, mais le remplacement du tableau par un autre serait sans doute long.

A+

 

[job75]

Re : Automatiser 3 fichiers Excel

Bonjour stagiairem,

Une variante (4 bis) : un fichier est fermé seulement si la macro l'a ouvert :

'-----
    'If fich <> Me.Name Then .Parent.Close
    If wb Is Nothing Then .Parent.Close 'si le fichier a été ouvert

Edit 1 : avec tous les fichiers ouverts il y a des sauts d'écran, je ne comprends pas pourquoi

Edit 2 : je vois que ça provient de l'instruction .Parent.Save mais ça ne m'éclaire pas plus.

A+

 

[job75]

Re : Automatiser 3 fichiers Excel

Bonjour,

Pour le problème des sauts d'écran des fichiers (4 bis) j'ai ouvert cette discussion :

https://www.excel-downloads.com/threads/sauts-decran-avec-la-commande-save.20000108/

A+

 

[stagiairem]

Re : Automatiser 3 fichiers Excel

Bonjour Job75,

J'ai une question, dans ton exemple tu trouves le moyen de supprimer les lignes non reperés , y'a t'il un moyen d'ajouter les lignes reperer en fonction du texte d'une colonne d'une autre feuille.

'---suppression des lignes non repérées---
With Workbooks(a(f)).Sheets(nomfeuil)
.Cells(1, "Z") = "x"
.Columns("A:Z").Sort .Columns("Z") 'tri pour accélérer
With .Columns("Z")
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
.Delete
End With

Par exemple dans l'exemple ci dessous, s'il l'on pouvait ajouter les lignes dans la feuille2, en fonction du texte " en cours" dans la colonne B de la feuille 1. ( par consequent dans le cadre d el'exemple 4 lignes devrait être reecrites).

Cordialement

 

[job75]

Re : Automatiser 3 fichiers Excel

Bonjour stagiairem;

Vous ne vous êtes pas manifesté depuis le post #8

Depuis j'ai proposé 2 autres versions, (4) et (4 bis), bien meilleures.

Quant à ce nouveau problème je ne vois vraiment pas ce que vous voulez faire avec votre 2ème feuille.

A+