Discussion :

[delphine1987]

Bonjour à tous,
J'ai vu des postes à ce sujet sur le forum mais je n'arrive pas à l'ajuster pour mon petit programme
Je souhaite comparer des données de deux fichiers excels

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
"#"Sub Actualiser()
  Dim R1 As Range
  Dim C As Range
Dim Sh As Worksheet
 
Dim LastLig As Long, NewLig As Long
Dim C As Range
Dim valeur As String
 
 
With Workbooks("2010 STD Activities status.xls").Sheets("2010")
   .AutoFilterMode = False
   LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
   With .Range("A4:X" & LastLig)
      .AutoFilter field:=24, Criteria1:=">0"
      .AutoFilter field:=11, Criteria1:="Fimp"
     End With
 
 Worksheets("STD").Select
  'boucle sur toutes les ref de STD
  For Each R1 In Range("A4:A" & LastLig).End(xlUp).Row
    'dans les ref de 2010
    With Worksheets("2010").Range("A6:A" & LastLig).End(xlUp).Row
      'on recherche la ref de STD
      Set C = .Find(R1.Value, LookIn:=xlValues, lookat:=xlWhole)
 
 
   If .Range("A4:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
      Set Sh = Worksheets("import")
      NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 1
      For Each C In .Range("A5:A" & LastLig).SpecialCells(xlCellTypeVisible)
              Sh.Cells(NewLig, 1).Value = .Cells(C.Row, 2).Value
       Sh.Cells(NewLig, 2).Value = .Cells(C.Row, 7).Value
       Sh.Cells(NewLig, 3).Value = .Cells(C.Row, 8).Value
         Sh.Cells(NewLig, 6).Value = .Cells(C.Row, 10).Value
         Sh.Cells(NewLig, 8).Value = .Cells(C.Row, 12).Value
         Sh.Cells(NewLig, 17).Value = .Cells(C.Row, 17).Value
         Sh.Cells(NewLig, 13).Value = .Cells(C.Row, 24).Value
         Sh.Cells(NewLig, 9).Value = .Cells(C.Row, 9).Value
         Sh.Cells(NewLig, 10).Value = .Cells(C.Row, 29).Value
         Sh.Cells(NewLig, 4).Value = UCase(Sh.Cells(NewLig, 1).Value) & UCase(Sh.Cells(NewLig, 2).Value)
         Sh.Cells(NewLig, 4).Value = Replace(Cells(NewLig, 3).Value, " ", "")
         NewLig = NewLig + 1
 
 
 
      Next C
      Set Sh = Nothing
      .AutoFilterMode = False
   End If
 
 
 
End With
End If
End Sub

Voilà mon code
Je souhaite comparer des données de deux fichiers et de deux feuilles différentes.

Si la ligne est déjà dans la feuille STD :
Si la colonne

Code :

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

Sh.Cells(NewLig, 13).Value = .Cells(C.Row, 24).Value

Sinon la copier (avec les contraintes citées)


[Edit]
je finis mon explication désolée^^

Si la colonne 13 de la feuille STD est différente de la colonne 24 de la feuille "2010"mettre à jour
Si vous avez des questions, n'hésitez pas!!

Merci d'avance pour votre aide

[delphine1987]

Hello,

J'ai réussi à faire quelque chose mais je n'arrive pas à combiner deux codes
Merci de votre aide

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
 
Sub Actualiser()
Dim c As Range, v As Range
 
Application.ScreenUpdating = False
Set Sh = ThisWorkbook.Sheets("std")
LastLig1 = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
Dim valeur As String
 
valeur = InputBox("Entrée période", "Choix de la période")
If valeur <> "" Then
Application.ScreenUpdating = False
 
With Workbooks("2010 STD Activities status.xls").Sheets("2010")
    .AutoFilterMode = False
    LastLig2 = .Cells(.Rows.Count, "B").End(xlUp).Row
    With .Range("A4:X" & LastLig2)
        .AutoFilter field:=17, Criteria1:=valeur
        .AutoFilter field:=24, Criteria1:=">0"
        .AutoFilter field:=11, Criteria1:="Fimp"
    End With
    If .Range("A4:A" & LastLig2).SpecialCells(xlCellTypeVisible).Count > 0 Then
        For Each v In .Range("A5:A" & LastLig2).SpecialCells(xlCellTypeVisible)
            If v.Value <> "" Then
                Set c = Sh.Range("A2:A" & LastLig1).Find(v.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not c Is Nothing Then
                    v.Resize(1, 24).Copy c
                    Set c = Nothing
                Else
                    LastLig1 = LastLig1 + 1
                    v.Resize(1, 24).Copy Sh.Range("A" & LastLig1)
                End If
            End If
        Next v
    End If
    .AutoFilterMode = False
End With
End If
Set Sh = Nothing
End Sub

J'ai fait ce premier code mais j'aimerais que les données se copient dans le bon ordre mais je ne sais pas comment imbriquer le code ci-dessous:

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
If .Range("A4:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
      Set Sh = Worksheets("import")
      NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 1
      For Each c In .Range("A5:A" & LastLig).SpecialCells(xlCellTypeVisible)
              Sh.Cells(NewLig, 1).Value = .Cells(c.Row, 2).Value
       Sh.Cells(NewLig, 2).Value = .Cells(c.Row, 7).Value
       Sh.Cells(NewLig, 3).Value = .Cells(c.Row, 8).Value
         Sh.Cells(NewLig, 6).Value = .Cells(c.Row, 10).Value
         Sh.Cells(NewLig, 8).Value = .Cells(c.Row, 12).Value
         Sh.Cells(NewLig, 17).Value = .Cells(c.Row, 17).Value
         Sh.Cells(NewLig, 13).Value = .Cells(c.Row, 24).Value
         Sh.Cells(NewLig, 9).Value = .Cells(c.Row, 9).Value
         Sh.Cells(NewLig, 10).Value = .Cells(c.Row, 29).Value
         Sh.Cells(NewLig, 4).Value = UCase(Sh.Cells(NewLig, 1).Value) & UCase(Sh.Cells(NewLig, 2).Value)
         Sh.Cells(NewLig, 4).Value = Replace(Cells(NewLig, 3).Value, " ", "")
         NewLig = NewLig + 1

Merci d'avance