Discussion :

[julien1603]

Bonjour,

J'ai besoin de vous afin de terminer ma macro. Je précise que je n'y connais rien en programmation.

Ci joint un fichier zip avec ma demande. En fait, je cherche à remplir les colonnes 14, 15, 16 du fichier "synthèse" en allant chercher les informations respectivement dans les fichiers "classeur1" "classeur2" "classeur3" se trouvant dans le dossier "données d'entrée". Pour trouver les informations afin de remplir ces colonnes, j'utilise la fonction rechercheV.

Le nombre de fichier excel dans le dossier "données d'entrée" peut évoluer. Ainsi, si il y a 5 fichiers excel, je dois remplir les colonnes 14, 15, 16, 17, 18.
J'aimerai également que tous les #N/A soit remplacés par des 0 uniquement pour les colonnes de 14 à ......

Afin de créer mon fichier de synthèse, j'utilise la macro suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Option Explicit
 
Dim fDep, f, i, lgn, derln
 
Sub Importer()
 Application.ScreenUpdating = False
 Set fDep = ActiveSheet
 Range("A1").CurrentRegion.Offset(1, 0).ClearContents
 MsgBox "Dans la fenêtre qui va s'ouvrir, chercher et sélectionner l'ensemble des fichiers dont il faut importer les données."
 f = Application.GetOpenFilename(, , , , True)
 For i = 1 To UBound(f)
 Workbooks.Open (f(i))
 ActiveWorkbook.Sheets("Part list").Select
 Range("B4:M" & Range("B" & Rows.Count).End(xlUp).Row - 1).Copy
 lgn = fDep.Range("R" & Rows.Count).End(xlUp)(2).Row
 fDep.Range("R" & lgn).PasteSpecial xlPasteValues
 Application.DisplayAlerts = False
 ActiveWorkbook.Close False
 Next i
 derln = Range("R" & Rows.Count).End(xlUp).Row
 Range("U2:U" & derln).Copy Range("A2")
 Range("R2:R" & derln).Copy Range("B2")
 Range("S2:S" & derln).Copy Range("C2")
 Range("AC2:AC" & derln).Copy Range("D2")
 Range("T2:T" & derln).Copy Range("H2")
 Range("V2:V" & derln).Copy Range("I2")
 Range("W2:W" & derln).Copy Range("J2")
 Range("Y2:Y" & derln).Copy Range("K2")
 Range("R2").CurrentRegion.ClearContents
 Range("A1").Select
 
 Cells.Select
 ActiveSheet.Range("$A$1:$P$642").RemoveDuplicates Columns:=2, Header:=xlYes
 
End Sub

J'ai besoin que le remplissage des colonnes de 14 à ...... se fasse après la fonction RemoveDuplicates.
J'espère avoir été clair.

Si vous avez des questions, n'hésitez pas.

D'avance merci pour vos aides.

Cordialement;

[tamtam64]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
    'dicos a partir de ma reference : fichier
Function GetPath(ByVal Source As String) As Dictionary
    'definition variables
Dim RangeTotal As Range, MyRange As Range
Dim MyDico As New Dictionary
Dim xlsheet As Worksheet
Set xlsheet = ThisWorkbook.Worksheets("nom de ton fichier")
    'Creation dico
With xlsheet
    Set RangeTotal = .Range(.Range(Source).Offset(1), .Range(Source).End(xlDown))
    'creation dico
For Each MyRange In RangeTotal
    If Not MyDico.Exists(MyRange.Value) Then
        MyDico.Add MyRange.Value, MyRange.Offset(, 1).Value
    End If
Next MyRange
End With

Avec ce dictionnaire tu peux recuperer le nom du classeur et et son adresse sur la colonne de droite , par exemple ( tu regle ca avec le offset) comme ca tu en rajoute autant que tu veux et pour l'appeler

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
MyDico=GetPath(nomdurangenomé)
set xlbook = application.workbooks(MyDico(NomClef))

voila si tu as des questions n'hesite pas mais ce model marche bien et est tres flexible