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

C@thy

XLDnaute Barbatruc
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
 
Dernière édition:

C@thy

XLDnaute Barbatruc
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
 

Pièces jointes

  • FichierL.xlsx
    400.2 KB · Affichages: 27
  • FichierO.xls
    121.5 KB · Affichages: 30
  • Compta.xlsx
    11.4 KB · Affichages: 42

job75

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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
 
Dernière édition:

job75

XLDnaute Barbatruc
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 :
Code:
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.
 

Pièces jointes

  • Compta.xlsm
    31.8 KB · Affichages: 37
  • FichierL.xlsx
    401.5 KB · Affichages: 31
  • FichierO.xls
    170 KB · Affichages: 30

C@thy

XLDnaute Barbatruc
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
 

C@thy

XLDnaute Barbatruc
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
 
Dernière édition:

C@thy

XLDnaute Barbatruc
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
 
Dernière édition:

job75

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Re,

Pour t'éviter tout souci tu peux utiliser un fichier 'Import' qui ne contient que cette macro :
Code:
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+
 

Pièces jointes

  • Import.xlsm
    21.8 KB · Affichages: 20
  • Compta.xlsx
    14.1 KB · Affichages: 20
  • FichierL.xlsx
    401.5 KB · Affichages: 35
  • FichierO.xls
    170 KB · Affichages: 23

Discussions similaires

  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
736
Réponses
23
Affichages
885
Réponses
2
Affichages
317

Statistiques des forums

Discussions
314 948
Messages
2 114 651
Membres
112 206
dernier inscrit
salah zabi