XL 2010 Copie de données de 2 classeurs vers un 3ème

[C@thy]

Bonjour le forum.

Y'avait longtemps... que je ne vous avais pas embêté... eh bien me revoilà!

J'explique ma problématique. Pour l'instant je ne peux pas joindre de fichier je n'ai pas XL sur ma tablette :-( et pas de réseau sur mon PC :-(((

Chaque mois je reçois 2 fichiers un fichier O et un fichier L.
L'identifiant commun se trouve en colonne A du fichier O et en colonne F du fichier L.
Je dois créer un 3ème fichier avec les informations suivantes :
Col A identifiant col B Nom (pris en col L du fichier L) col C prénom (pris en col M du fichier L)
Col D tél (pris en col Y du fichier L) col E Section (pris en col N du fichier L) col F description (pris en col O du fichier O) et col G montant (pris en colonne S du fichier O).

Édit : erreurrrrr. .. la description se trouve en col B du fichier O et non col O

Là où ça se corse c'est que dans le fichier O l'identifiant peut apparaître 2 fois mais pas à la suite. Une fois dans la col. description, il y a téléphone et si il y a une 2ème occurrence dans la col. description il y a accessoire. Je dois recopier les informations des 2 lignes l'une à la suite de l'autre.

Pour l'instant voici mon code : (recopié à la mano)

Option explicit
Sub MaMacro
Dim chemin as string, fichierO as string, FichierL as string, R as string
Dim cel as range
Chemin = "C:\toto"
Chdir chemin
fichier = Dir ("*.xls*")
While fichier <> "" and fichier <> thisworkbook.name
Workbooks.open (chemin & fichier)
Wend
Workbooks.add
Active Workbooks.open. sa vers Filename := chemin & "compta"
Range ("A1"). FormulaR1C1 = "Liasse"
Range ("B1"). FormulaR1C1 = "Nom"
Range ("C1"). FormulaR1C1 = "Prenom"
Range ("D1"). FormulaR1C1 = "tel"
Range ("E1"). FormulaR1C1 = "Description"
Range ("F1"). FormulaR1C1 = "montant"
Range ("G1"). FormulaR1C1 = "Num facture"

With Workbook ("fichier O. xlsx")
for each cel in range ("A2:A" & rows. Count).end (xlup).row
set R = sheets("Feuil1").find (what:=cel.Value)
If not cel is nothing then
........
........
'recherche si suivant même identifiant
Sélection. Find (After:=ActiveCell).activate
End if
Next cel
End sub

Un très très grand Merci pour votre aide.

P.S Ne pas joindre de fichier je ne pourrais pas lire le code...

Au plaisir de vous lire et salutations à toutes celles et ceux que je connais.

C@thy

 

[job75]

Bonjour à tous,

Juste pour te saluer ma chère C@thy, cela fait un bout de temps en effet qu'on ne t'a pas vue.

Il faudrait vraiment un fichier, sans ça on va pédaler dans la choucroute

A bientôt.

 

[C@thy]

Coucou Gérard. Comment tu vas bien? Ca fait très plaisir de te voir

Eh oui, je le savais, rien ne vaut un bon fichier... alors voici l'exemple.

On part des n° de liasse du fichierO et on va chercher les infos dans fichierO et fichierL pour constituer compta.
C'est parfois un peu plus compliqué que cela. Parfois le N° de liasse de février de O se retrouve dans l'onglet janvier de L. Quoiqu'il en soit, il ne se trouve que dans un seul mois de L.

Jespere que mon exemple sera parlant.

Mille bises à tous

C@thy

 

[Lone-wolf]

Bonjour C@thy , Gérard

Très bien revenue sur XLD et bisous à toi aussi

Gérard, j'aurais preféré pedaler ailleur que dans la choucroute (trop de gras)

 

[job75]

Bonjour C@thy, salut Lone-wolf,

J'ai bien fait de demander les fichiers car c'est déjà de la choucroute.

Comme il n'y a pas des identifiants uniques je ne vois pas comment faire quelque chose qui tienne la route.

A+

 

[C@thy]

L'identifiant commun est le code liasse. Il se trouve en colonne F du fichier O et en colonne D du fichierL.

On part du code Liasse en colonne D du fichierL qui est donc l'identifiant commun et on recherche cet identifiant dans la colonne F du fichierO ensuite on recopie les informations souhaitées dans un nouveau fichier compta. Tu vois le truc ou je ne suis pas claire? (Normal puisque je suis C@thy... lol...)

Par exemple FichierL onglet février D2 = FichierO onglet détail commandes F3

 

[job75]

Re,

Bon je vois que si dans FichierL.xlsx les numéros de liasses ne sont pas uniques ça n'a pas d'importance.

Alors utilise cette macro dans le fichier Compta.xlsm :

Private Sub CommandButton1_Click() 'bouton Importer
Dim i As Long, j As Variant, fichL As Workbook, fichO As Workbook, liasse As Long, w As Worksheet
For i = 1 To Workbooks.Count
  If Workbooks(i).Name Like "FichierL.xls*" Then j = j + 1: Set fichL = Workbooks(i)
  If Workbooks(i).Name Like "FichierO.xls*" Then j = j + 1: Set fichO = Workbooks(i)
Next
If j < 2 Then MsgBox "Les fichiers 'FichierL' et 'FichierO' doivent être ouverts...": Exit Sub
If Application.CountA(Range("H2:H" & Rows.Count)) Then _
  If MsgBox("Les N° de factures vont être effacés, voulez-vous continuer ?", 4) = 7 Then Exit Sub
Application.ScreenUpdating = False
Range("A2:H" & Rows.Count) = "" 'RAZ
With fichO.Sheets(2).[A1].CurrentRegion 'la 2ème feuille est copiée
  For i = 2 To .Rows.Count
    liasse = Val(.Cells(i, 6))
    Cells(i, 1) = liasse
    Cells(i, 6) = .Cells(i, 2)
    Cells(i, 7) = .Cells(i, 19)
    For Each w In fichL.Worksheets
      j = Application.Match(liasse, w.[D:D], 0)
      If IsNumeric(j) Then
        Cells(i, 2) = w.Cells(j, 12)
        Cells(i, 3) = w.Cells(j, 13)
        Cells(i, 4) = w.Cells(j, 25)
        Cells(i, 5) = w.Cells(j, 14)
        Exit For
      End If
  Next w, i
End With
[A1].CurrentRegion.Sort [A1], xlAscending, Header:=xlYes 'tri
End Sub

Fichiers joints.

Bonne fin de soirée.

 

[C@thy]

Un très grand merci, Gérard pour cette intervention.

En fait je me suis trompée de version, je n'ai que 2007 donc pas de xlsm mais je vais copier ta macro et je te tiens au courant.

Bonne soirée et à bientôt

C@thy

 

[job75]

Re,

je n'ai que 2007 donc pas de xlsm

C@thy les fichiers .xlsm existent depuis Excel 2007 !

Bonne nuit.

 

[C@thy]

Mais je n'arrive pas à lire tes fichiers joints

C@thy

 

[C@thy]

J'ai un souci : Workbooks. Count s'arrête à 1 qui est compta.xlsm pourtant les 3 sont dans le répertoire. ... peux-tu poster tes 3 fichiers en version 2007 stp??? Merci à toi. Biz

Édit : Arf! j'ai compris ! Il faut ouvrir les fichiers avant... mais ça ne m'arrange pas!!!

C@thy

 

[C@thy]

Ok j'ai testé, c'est parfait, comme d'hab, et quelle concision!

Y'a juste un tout petit truc : si le numéro de liasse n'est pas trouvé on remplit quand même les colonnes F et G (prix et description) de compta alors que toute la ligne sauf la col A doit rester vide.

Sinon, c'est nickel.

Un très grand MERCI.

Biz

Édit : encore un tout petit truc : le fichier est destiné à être envoyé à la compta. Comment enregistrer compta sans bouton et sans macro? Merciiiiiii

C@thy

 

[job75]

Bonjour C@thy, le forum,

Y'a juste un tout petit truc : si le numéro de liasse n'est pas trouvé on remplit quand même les colonnes F et G (prix et description) de compta alors que toute la ligne sauf la col A doit rester vide.

Il faut bien avoir compris que toutes les lignes de FichierO sont copiées.

FichierL ne sert qu'à compléter les colonnes B C D E.

Édit : encore un tout petit truc : le fichier est destiné à être envoyé à la compta. Comment enregistrer compta sans bouton et sans macro? Merciiiiiii

Eh bien supprime le bouton et enregistre le fichier en .xlsx.

Bonne journée.

 

[C@thy]

Oui justement c'est ça, supprimer le bouton et enregistrer en .xlsx mais par macro. J'ai essayé un truc mais ça marche pas il me dit un truc du genre toutes les macros seront perdues je dis OK mais après il dit qu'il ne peut pas...

 

[job75]

Re,

Pour t'éviter tout souci tu peux utiliser un fichier 'Import' qui ne contient que cette macro :

Private Sub CommandButton1_Click() 'bouton Import
Dim i As Long, j As Variant, F As Worksheet, fichL As Workbook, fichO As Workbook, liasse As Long, w As Worksheet
For i = 1 To Workbooks.Count
  If Workbooks(i).Name Like "Compta.xls*" Then j = j + 1: Set F = Workbooks(i).Sheets(1) '1ère feuille
  If Workbooks(i).Name Like "FichierL.xls*" Then j = j + 1: Set fichL = Workbooks(i)
  If Workbooks(i).Name Like "FichierO.xls*" Then j = j + 1: Set fichO = Workbooks(i)
Next
If j < 3 Then MsgBox "Les 3 fichiers 'Compta','FichierL' et 'FichierO' doivent être ouverts...": Exit Sub
If Application.CountA(F.Range("H2:H" & F.Rows.Count)) Then _
  If MsgBox("Les N° de factures vont être effacés, voulez-vous continuer ?", 4) = 7 Then Exit Sub
Application.ScreenUpdating = False
F.Range("A2:H" & F.Rows.Count) = "" 'RAZ
With fichO.Sheets(2).[A1].CurrentRegion 'la 2ème feuille est copiée
  For i = 2 To .Rows.Count
    liasse = Val(.Cells(i, 6))
    F.Cells(i, 1) = liasse
    F.Cells(i, 6) = .Cells(i, 2)
    F.Cells(i, 7) = .Cells(i, 19)
    For Each w In fichL.Worksheets
      j = Application.Match(liasse, w.[D:D], 0)
      If IsNumeric(j) Then
        F.Cells(i, 2) = w.Cells(j, 12)
        F.Cells(i, 3) = w.Cells(j, 13)
        F.Cells(i, 4) = w.Cells(j, 25)
        F.Cells(i, 5) = w.Cells(j, 14)
        Exit For
      End If
  Next w, i
End With
F.[A1].CurrentRegion.Sort F.[A1], xlAscending, Header:=xlYes 'tri
F.Parent.Save 'enregistrement
End Sub

Les 3 fichiers 'Compta', 'FichierL' et 'FichierO' doivent être ouverts.

A+