Discussion :

[Vadorblanc]

Bonjour
Cette macro pointe un fichier pour s'exécuter correctement par:
'sur le classeur sélectionné par l'utilisateur
'Pour chaque modif de col H dans Feuille 2
'si H est dans Feuille 1 alors rien sinon copier de A:AA dans Sheet Add

Je souhaiterais qu'elle soit intégrée au fichier lui-même ayant ses 2 onglets à comparer, il faut donc supprimer l'appel du fichier, j'ai essayé maintes tentatives...je sais qu'il faut modifier ses lignes de codes:

Code :

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

1
2
3
Classeur = Application.GetOpenFilename("Classeurs Excel,*.xls")
If Classeur <> False Then
    Set wbk = Workbooks.Open(Classeur)

Voici la macro à modifier:

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
36
37
38
39
40
41
42
Sub Compare_ColH_sur_2_Sheets()
'sur le classeur sélectionné par l'utilisateur
'Pour chaque modif de col H dans Feuille 2
'si H est dans Feuille 1 alors rien sinon copier de A:AA dans Sheet Add
 
 
Dim wbk As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim Classeur As Variant
Dim LastLig1 As Long, LastLig2 As Long, i As Long, k As Long
Dim c As Range, v As Range
 
Application.ScreenUpdating = False
Classeur = Application.GetOpenFilename("Classeurs Excel,*.xls")
If Classeur <> False Then
    Set wbk = Workbooks.Open(Classeur)
    Set ws1 = wbk.Worksheets(1)  'sheet CG
    Set ws2 = wbk.Worksheets(2)  'sheet RRH
    LastLig1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    LastLig2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
 
    Set ws3 = wbk.Worksheets.Add(After:=wbk.Sheets(wbk.Worksheets.Count))
    For i = 1 To LastLig2
        Set c = ws1.Range("H1:H" & LastLig1).Find(ws2.Range("H" & i).Value, lookat:=xlWhole)
        If c Is Nothing Then
        Set v = ws3.Columns(1).Find(ws2.Range("H" & i).Value, lookat:=xlWhole)
        If v Is Nothing Then
            k = k + 1
            ws2.Range("A" & i & ":AA" & i).Copy ws3.Range("A" & k)
            End If
        End If
        Set v = Nothing
    Next i
    Set c = Nothing
    Set ws3 = Nothing
    Set ws2 = Nothing
    Set ws1 = Nothing
    'wbk.Save
    'wbk.Close
    Set wbk = Nothing
End If
End Sub

Merci

[keygen08]

Bonjour

Comme ceci

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
36
37
38
39
40
41
42
Sub Compare_ColH_sur_2_Sheets()
'sur le classeur sélectionné par l'utilisateur
'Pour chaque modif de col H dans Feuille 2
'si H est dans Feuille 1 alors rien sinon copier de A:AA dans Sheet Add
 
 
Dim wbk As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
'Dim Classeur As Variant
Dim LastLig1 As Long, LastLig2 As Long, i As Long, k As Long
Dim c As Range, v As Range
 
Application.ScreenUpdating = False
'Classeur = Application.GetOpenFilename("Classeurs Excel,*.xls")
'If Classeur <> False Then
    Set wbk = ThisWorkbook
    Set ws1 = wbk.Worksheets(1)  'sheet CG
    Set ws2 = wbk.Worksheets(2)  'sheet RRH
    LastLig1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    LastLig2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
 
    Set ws3 = wbk.Worksheets.Add(After:=wbk.Sheets(wbk.Worksheets.Count))
    For i = 1 To LastLig2
        Set c = ws1.Range("H1:H" & LastLig1).Find(ws2.Range("H" & i).Value, lookat:=xlWhole)
        If c Is Nothing Then
        Set v = ws3.Columns(1).Find(ws2.Range("H" & i).Value, lookat:=xlWhole)
        If v Is Nothing Then
            k = k + 1
            ws2.Range("A" & i & ":AA" & i).Copy ws3.Range("A" & k)
            End If
        End If
        Set v = Nothing
    Next i
    Set c = Nothing
    Set ws3 = Nothing
    Set ws2 = Nothing
    Set ws1 = Nothing
    'wbk.Save
    'wbk.Close
    Set wbk = Nothing
'End If
End Sub

[Vadorblanc]

Bonjour keygen08

C'était donc la variable "Classeur" que je n'avais pas supprimé, le reste j'avais fait...

Code :

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

'Dim Classeur As Variant

Un grand merci à toi, tout fonctionne maintenant sur le fichier, c'est excellent...