Discussion :

[safouunette]

Bonjour,
je souhaite coller dans la 3eme feuille les lignes entieres (champ de la colonne A à I) qui ne se trouvent pas dans la feuille ws1 (je ne veux pas le contraire)
PS: j'ai envie de copier dans la derniere ligne de la feuille ws2 ce resultat mais vu que je ne sais pas comment car j'ai eu des doublons dans une autre macro. Je compte en premier temps coller les resultats dans une troixieme feuille et puis les (couper coller) dans la premiere ligne vide de la ws1.
cette macro ne repond pas à mes attentes car elle ne me copie que les lignes ayant la colonne A différente or moi j'ai des doublons au niveaux des colonnes A mais pas toutes les lignes.

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub restriction()
Dim wbk As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim LastLig1 As Long, LastLig2 As Long, i As Long, k As Long
Dim c As Range, v As Range
 
Application.ScreenUpdating = False
    Set wbk2 = ThisWorkbook
    Set wbk1 = Application.Workbooks.Open("C:\Archives PROG\RECAP.xls")
    Set ws2 = wbk2.Worksheets("rest")
    Set ws1 = wbk1.Worksheets("RECAP")
    With ws1.Columns
    .Interior.ColorIndex = xlColorIndexNone
    End With
 
    LastLig1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    LastLig2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
 
    Set ws3 = wbk1.Worksheets(2)
    For i = 1 To LastLig2
        Set c = ws1.Range("A1:I" & LastLig1).Find(ws2.Range("A" & i & ":I" & i).Value, lookat:=xlWhole)
        If c Is Nothing Then
        Set v = ws3.Rows.Find(ws2.Range("A" & i & ":I" & i).Value, lookat:=xlWhole)
        If v Is Nothing Then
            k = k + 1
            ws2.Range("A" & i & ":I" & i).Copy ws3.Rows(k)
            End If
        End If
        Set v = Nothing
    Next i
    Set c = Nothing
    Set ws3 = Nothing
    Set ws2 = Nothing
    Set ws1 = Nothing
    wbk1.Save
    wbk1.Close
    wbk2.Save
    Set wbk1 = Nothing
    Set wbk2 = Nothing
call histo
End Sub
 
Sub histo()
'coupe les données de la 3eme feuille et les coller
'dans la premiere ligne vide de la ws1
Dim F_S As Worksheet
Dim F_D As Worksheet
Dim Lig_S As Long
Dim Lig_D As Long
Application.ScreenUpdating = False
Dim ClasseurPrincipal As Workbook
Set ClasseurPrincipal = Application.Workbooks.Open("C:\Archives PROG\RECAP.xls")
Set F_D = ClasseurPrincipal.Sheets("RECAP")
Set F_S = ClasseurPrincipal.Sheets("Feuil2")
 
Lig_D = F_D.Range("A65536").End(xlUp).Row + 1
    For Lig_S = 1 To F_S.Range("A65536").End(xlUp).Row Step 1
        F_S.Rows(Lig_S).Cut Destination:=F_D.Rows(Lig_D)
        Lig_D = Lig_D + 1
    Next Lig_S
 
ClasseurPrincipal.Save
ClasseurPrincipal.Close
Set ClasseurPrincipal = Nothing
Application.CutCopyMode = False
End Sub

merci pour votre aide

[Nelson77]

J'ai pas bien suivi...

Tu as 2 feuilles ws1 et ws2 avec des données en lignes.

Tu veux juste ajouter les lignes de ws1 à la fin de la liste de ws2 uniquement si la valeur de la colonne A n'existe pas en ws2?

[safouunette]

Bonjour,
Oui, mais pas que la colonne A qui doit etre différente. Je ne copie que si le contenu de toute la ligne est différent (il se peut que la valeur de A existe mais les autres valeurs des autres colonnes ne sont pas les memes)
j'ai reussi à faire une autre macro qui marche et me donne le resultat que je cherche sauf que ca prend un temps enorme vu que j'ai des centaines de lignes!!!

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
43
44
45
46
47
48
49
50
Sub Copie_difference()
Dim iLRA%, iLRN%
Dim WbA As Workbook, WbN As Workbook
Dim WsA As Worksheet, WsN As Worksheet
Application.ScreenUpdating = False
 
Set WbN = ThisWorkbook
Set WbA = Application.Workbooks.Open("C:\RECAP.xls")
Set WsA = WbA.Worksheets("RECAP FICHE")
Set WsN = WbN.Worksheets("RECAP FICHE")
 
WsN.Range("I:I").EntireColumn.Hidden = False
WsA.Range("G:I").EntireColumn.Hidden = False
 
iLRA = WsA.Cells(65535, 1).End(xlUp).Row
iLRN = WsN.Cells(65535, 1).End(xlUp).Row
 
WsN.Range("A2:I" & iLRN).SpecialCells(xlCellTypeVisible).Copy WsA.Range("A" & iLRA + 1)
 
With WsA
    Set Plage = .Range(.[A1], .[I65536].End(xlUp))
End With
 
With Plage
 
For i = 2 To .Rows.Count - 1
    For j = .Rows.Count To i + 1 Step -1
            For k = 1 To 9
                If .Rows(i).Cells(k) = .Rows(j).Cells(k) Then
                    L = L + 1
                End If
            Next k
            If L = 9 Then
                With .Rows(j)
                    .EntireRow.Delete
                End With
            End If
        L = 0
    Next j
Next i
End With
WsN.Range("I:I").EntireColumn.Hidden = True
WsA.Range("G:I").EntireColumn.Hidden = True
WbN.Save
WbA.Save
Set WbA = Nothing
Set WbN = Nothing
Set WsA = Nothing
Set WsN = Nothing
End Sub

Pour le moment je travaille avec cette macro mais si il y a des améliorations je serai ravie
Cordialement
Saf