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
| Sub A_inventaire_par_Boites_Dialogue_Test() ' Ne fonctionne pas, (en cours de modifs)
Rem -compare la cellule "A2" de la colonne "A" feuille "Essai" classeur "Inventaire-Essai.xls" avec toutes les cellules de la colonne "B" de la feuille "Recapitulatif" du classeur "1Emplacement"
'Si une valeur identique est trouvée: Remplacer le contenu de la cellule "3" (C) de la feuille Essai du classeur "Inventaire-Essai.xls"
'par le contenu de la cellule de la colonne "J" de la feuille "Recapitulatif" du classeur "1Emplacement" dont la valeur est la même.
'Sinon reprendre la comparaison a la cellule "A3" et ce jusqu'à la fin de la colonne "A"
'Travail sur 2 feuilles dans 2 classeurs différents)
'Choix des classeurs, des feuilles et des colonnes à comparer et à copier : par inputbox (ou par userform)
'Définition =======================
Dim Cel As Range, Cel_A As Range
Dim F_A As Worksheet, F_B As Worksheet ', x As Worksheet, y As Worksheet, z As Worksheet
Dim Fi1 As String, Fi2 As String, F1 As String, F2 As String, co1 As Range, co2 As Range, C1 As String, C2 As String, Dep As String, Ar As String
'Attribution des variables ==============================
Fi1 = InputBox("Nom du fichier 1", "Nom1")
Fi2 = InputBox("Nom du fichier 2", "Nom2")
F1 = InputBox("Nom de la feuille 1", "Feuil1")
F2 = InputBox("Nom de la feuille 2", "Feuil2")
'On Error GoTo ErreurFichier
C1 = InputBox("Colonne de référence 1", "Colonne1")
C2 = InputBox("Colonne de référence 2", "Colonne2")
Dep = InputBox("Nombre de colonne entre la Colonne de référence et la colonne de copie", "Depart")
Ar = InputBox("Colonne d' arrivée (collage)", "Arrivee")
Set co1 = [(C1) & "2": (C1)& Selection.End(xlUp)].Range 'Problème : (c'est là que ça coince)
Set co2 = [C2 & "2": C2& Selection.End(xlUp)].Range 'Problème : (là,ça doit coincer aussi)
Set F_A = Workbooks(Fi1 & ".xls").Sheets(F1).Range(co1)
Set F_B = Workbooks(Fi2 & ".xls").Sheets(F2).Range(co2)
'Traitement =======================
'F_A = feuille du classeur déterminés par inputbox
'For Each Cel In F_A.Range(F_A.[A1], F_A.Range("A" & Rows.Count).End(xlUp))
For Each Cel In co1
If Not (IsEmpty(Cel)) Then 'si Cel n'est pas vide
'Set Cel_A = F_B.Columns(2).Find(Cel) 'Columns(2)= colonne B
'fixer Cel_a en tant cellule trouvée identique à Cel
'Set Cel_A = co2
If Not (co2 Is Nothing) Then
'si Cel_A existe
F_B.Range(Cel_A.Offset(0, Dep), Cel_A.Offset(0, Dep)).Copy F_A.Cells(Cel.Row, (Ar))
'F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C")
'Copie les cellules F de la feuille 4 en C de la feuille 3
'(J=9 : Colonne de référence + différence pour colonne à copier)
End If
End If
Next Cel 'Boucle sur cellule suivante
Exit Sub
ErreurFichier:
MsgBox "!Erreur de nom de classeur ou de feuille !"
End Sub |
