Affectation/Matching des valeurs d'un fichier Excel A à un fichier B à partir d'un fichier C

Version imprimable

1 pièce(s) jointe(s)

Bonjour Team,
J'espère que vous allez bien!

J'ai un problème au niveau des affectations d'un fichier A à un fichier B à partir d'un fichier C dans lequel est écrit mon code VBA;
En effet, dans C , il y'a un bouton qu'on click et ca part prendre au fur et à mesure des valeurs dans A et par les comparées à celle dans B;
quant elle trouve une correspondance, elle copie certaines données de cette ligne et va la copier dans A sur la ligne correspondante(cellule après cellule).

L'action s'effectue bien, le code gère bien la fermeture des fichiers; mais quant j'ouvre bien après mon fichier A pour vérifier la copie des données, le fichier n'affiche rien (ni de colonne, ni de cellule, et souvent il est accompagné d'une alerte "Avis de sécurité Microsoft Excel" que j'active mais sans retour favorable malgré cela). Voir pièce jointe

Esquisse du code : J'ai créer 02 modules à cet effet (Merci d'avance :D:P:P :arf:)

Module 1 :

Code:

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
Public iCel, indexCel, RowFm, RowBal, Plage, Nb, Row_Bal As Long
Public CelBal, CelFm, colonne, NowFm, NowBal, recept_plage, PointFm, PointBal, cptBal_1, cptBal_2 As String
Public FichE1, FichE2 As Workbook
Public ws, ws2 As Worksheet
Public la_date As Date
Sub affectation()
 
   Dim NumEuroLine, NumTrackLine As Long
   RowFm = "5"
   RowBal = "4"
 
   Call Module1.ExtraVal(RowFm, RowBal)
 
End Sub
 Public Sub OpenCnx()
    Set FichE1 = GetObject("D:\SESAME\8\balance.xlsx")
    Set ws = FichE1.Sheets(1)
    Set FichE2 = GetObject("D:\SESAME\8\FM1000.xlsx")
    Set ws2 = FichE2.Sheets(1)
    End Sub
Function ExtraVal(ByVal AdressFm As String, ByVal AdressBal As String)
    Call OpenCnx
 
    PointFm = "A" & AdressFm
    NowFm = ws2.Range(PointFm).Value
 
    'Worksheets("FM1000").Range(PointFm).Value
    Call EuroLine(CInt(AdressBal))
    If Nb = 0 Then
       MsgBox "Aucune ligne affectée !! ", vbInformation, "ADVANS Cameroun"
    Else
       FichE1.Close
       FichE2.SaveCopyAs "D:\FM10000.xls"
 
 
 
       'ActiveWorkbook.Save
       FichE2.Close SaveChanges:=True
       MsgBox "Nombre de ligne(s) inscrite(s) : " & Nb, vbInformation, "ADVANS Cameroun"
    End If
 
 
End Function
Public Sub EuroLine(NumT As Long)
 
Nb = 0
Row_Bal = "4"
 
cptBal_1 = "A" & NumT
cptBal_2 = ws.Range(cptBal_1).Value
 
 
 
Do Until (cptBal_2 = "")
    Row_Bal = Row_Bal + 1
    PointBal = "A" & Row_Bal
    cptBal_2 = ws.Range(PointBal).Value
Loop
 
Do Until (NowFm = "")
 
 For Plage = NumT To Row_Bal
    recept_plage = "A" & Plage
    NowBal = ws.Range(recept_plage).Value
    If StrComp(Trim(NowFm), Trim(NowBal)) = 0 Then
        Nb = Nb + 1
        RowBal = Plage
        Call importer(1, 6)
        Exit For
    End If
 Next Plage
 RowFm = RowFm + 1
 PointFm = "A" & RowFm
 NowFm = ws2.Range(PointFm).Value
Loop
 
End Sub

Module 2 :

Code:

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Public Sub importer(x As Integer, y As Integer)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.ReferenceStyle = xlA1
Call OpenCnx
 
     For iCel = x To y
       Call CrossLine
       ws.Range(CelBal).Copy
 
 
 
       ws2.Activate
       'Application.Workbooks("FM1000.xlsx").Worksheets("FM1000").Activate
       ws2.Range(CelFm).Select
       ActiveSheet.PasteSpecial
 
 
       'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       'False, Transpose:=False
 
       'MsgBox "Coller : " & ws2.Range(CelFm).Value
       'Exit For
     Next iCel
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
 
End Sub
Public Sub CrossLine()
 Select Case iCel
        Case 1
            CelBal = "C" & RowBal
            CelFm = "C" & RowFm
        Case 2
            CelBal = "D" & RowBal
            CelFm = "E" & RowFm
        Case 3
            CelBal = "F" & RowBal
            CelFm = "E" & RowFm
        Case 4
            CelBal = "G" & RowBal
            CelFm = "F" & RowFm
        Case 5
            CelBal = "H" & RowBal
            CelFm = "G" & RowFm
        Case 6
            CelBal = "G" & RowBal
            CelFm = "H" & RowFm
    End Select
End Sub

18/01/2022, 15h16
Philippe Tulliez

Bonjour,
Même si cela n'explique absolument pas le problème que vous rencontrez, vous avez un problème de typage de variable dans vos premières lignes
Exemple pour la troisième mais c'est vrai pour l'ensemble Public FichE1, FichE2 As Workbook. Ici seul FichE2 est typé Workbook alors que l'autre est Variant

Je vous conseille la lecture de Utiliser les variables en VBA Excel et tout particulièrement le chapitre II. Les types de données

Je n'ai pas très bien compris ce que vous cherchez à faire car votre titre évoque un "matching" de données et votre code semble effectuer des copies.
Une copie d'écran de vos liste avec une image de ce que vous attendez en final serait un plus
18/01/2022, 17h22
crupa

2 pièce(s) jointe(s)

Philippe Tulliez, Merci pour ta prompte réaction

J'ai modifié comme tu m'a conseillé pour un début; cela réagit pareillement !

Voici quelques explications avec un cas réel : (en Piece jointe les captures)

Quant je clique le bouton dans le fichier C :

Je fixe dès le départ la valeur de la cellule A5 (cf variable RowFm) dans le fichier A, j'ouvre le fic B ,que je parcours à partir de A4 que j'ai aussi fixé.

Quant la valeur est trouvée, elle relève la ligne, particulièrement les valeurs Nom(B6) et prénom(C6) une à une pour ce cas, et repart dans le fichier A les copier dans les cases correspondantes.

Dans test de valeurs avec les breakpoints ou les Msgbox, je test si la copie s'effectue en affichant la valeur des cellules ,cela est OK 8O; je me dis alors que peut être c'est la fermeture des fichiers qui se passe mal. :help::furieux:

Merci bien !
18/01/2022, 19h02
Philippe Tulliez
Bonjour,
Si j'ai bien compris, il s'agit de "matcher" les données comme le titre de la discussion le précisait.
Dans ce cas, pourquoi un code si long alors que déjà la fonction EQUIV (MATCH pour la version anglaise) suffit amplement à résoudre ce problème même s'il fallait l'automatiser en VBA cela ne devrait pas tenir dans plus de dix lignes.

Deux billets sur le sujet, vous inspireront peut-être
- Comment comparer (matcher) des données dans Excel
- Exporter les données comparées (« Matchées »)
La combinaison des fonctions INDEX/EQUIV ou RECHERCHEX peut remplir les cellules Nom et prénom déjà sans VBA
19/01/2022, 09h07
crupa

Bonjour Philippe,

Merci bien; j'essaye et je te reviens au besoin stp !