Lister une plage de cellules pour pouvoir les comparer

[Sylvagreg]

Bonjour,

Je suis débutant et bricole avec ce que je trouve sur ce type de forum.
Là je coince, la définition des plages ne fonctionne pas. Est ce que quelqu'un pourrait me corriger le code?
Merci d'avance😡

' Fusion
Dim i&, j&, DerL&
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim PlageWs1 As Range, PlageWs2 As Range
Set Ws1 = Worksheets("Fusion"): Set Ws2 = Worksheets("Salaires au 31 12")
Set PlageWs1 = (Cells(i, 2), Cells(i, 4))
Set PlageWs2 = (Cells(j, 2), Cells(j, 4))
With Ws2
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
DerL = Ws1.Cells(Rows.Count, 1).End(xlUp)(2).Row
If Not IsError(Application.Match(PlageWs1, PlageWs2, 0)) Then
For j = 1 To DerL
If (Cells(j, 2) + Cells(j, 3) + Cells(j, 4)) = (.Cells(i, 2) + .Cells(i, 3) + .Cells(i, 4)) Then
Ws1.Cells(j, 18) = .Cells(i, 13)
Ws1.Cells(j, 19) = .Cells(i, 14)
Ws1.Cells(j, 20) = .Cells(i, 17)
End If
Next
Else
Ws1.Cells(DerL, 1) = .Cells(i, 1)
Ws1.Cells(DerL, 2) = .Cells(i, 2)
Ws1.Cells(DerL, 3) = .Cells(i, 3)
Ws1.Cells(DerL, 4) = .Cells(i, 4)
Ws1.Cells(DerL, 5) = .Cells(i, 5)
Ws1.Cells(DerL, 6) = .Cells(i, 6)
Ws1.Cells(DerL, 7) = .Cells(i, 7)
Ws1.Cells(DerL, 8) = .Cells(i, 8)
Ws1.Cells(DerL, 9) = .Cells(i, 9)
Ws1.Cells(DerL, 10) = .Cells(i, 10)
Ws1.Cells(DerL, 11) = .Cells(i, 11)
Ws1.Cells(DerL, 12) = .Cells(i, 12)
Ws1.Cells(DerL, 15) = .Cells(i, 15)
Ws1.Cells(DerL, 16) = .Cells(i, 16)
Ws1.Cells(DerL, 18) = .Cells(i, 13)
Ws1.Cells(DerL, 19) = .Cells(i, 14)
Ws1.Cells(DerL, 20) = .Cells(i, 17)
DerL = DerL + 1
End If
Next
End With
End Sub

 

[Pierrot93]

Re : Lister une plage de cellules pour pouvoir les comparer

Re,

sans dout modifier ceci :

For j = 1 To Ws1.Cells(Rows.Count, 1).End(xlUp)(2).Row

par cela :

For j = 1 To Ws1.Cells(Rows.Count, 1).End(xlUp).Row

 

[Pierrot93]

Re : Lister une plage de cellules pour pouvoir les comparer

Re,

ceci fonctionne chez moi...

Option Explicit
Sub Macro1()
Dim i&, j&, Ws1 As Worksheet, Ws2 As Worksheet
Sheets("Fusion").Cells.ClearContents
Sheets("Salaires actuels").Cells.Copy Sheets("Fusion").Range("A1")
Set Ws1 = Worksheets("Fusion"): Set Ws2 = Worksheets("Salaires au 31 12")
     With Ws2
         For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
             For j = 1 To Ws1.Cells(Rows.Count, 1).End(xlUp).Row
                If (Ws1.Cells(j, 2) & Ws1.Cells(j, 3) & Ws1.Cells(j, 4)) = (.Cells(i, 2) & .Cells(i, 3) & .Cells(i, 4)) Then
                    Ws1.Cells(j, 18) = .Cells(i, 13)
                    Ws1.Cells(j, 19) = .Cells(i, 14)
                    Ws1.Cells(j, 20) = .Cells(i, 17)
                 Else
                     Ws1.Cells(j, 1) = .Cells(i, 1)
                     Ws1.Cells(j, 2) = .Cells(i, 2)
                     Ws1.Cells(j, 3) = .Cells(i, 3)
                     Ws1.Cells(j, 4) = .Cells(i, 4)
                     Ws1.Cells(j, 5) = .Cells(i, 5)
                     Ws1.Cells(j, 6) = .Cells(i, 6)
                     Ws1.Cells(j, 7) = .Cells(i, 7)
                     Ws1.Cells(j, 8) = .Cells(i, 8)
                     Ws1.Cells(j, 9) = .Cells(i, 9)
                     Ws1.Cells(j, 10) = .Cells(i, 10)
                     Ws1.Cells(j, 11) = .Cells(i, 11)
                     Ws1.Cells(j, 12) = .Cells(i, 12)
                     Ws1.Cells(j, 15) = .Cells(i, 15)
                     Ws1.Cells(j, 16) = .Cells(i, 16)
                     Ws1.Cells(j, 18) = .Cells(i, 13)
                     Ws1.Cells(j, 19) = .Cells(i, 14)
                     Ws1.Cells(j, 20) = .Cells(i, 17)
                 End If
             Next j
         Next i
     End With
End Sub

A voir maintenant si c'est le résultat attendu...

 

[Si...]

Re : Lister une plage de cellules pour pouvoir les comparer

salut

avec ce que j'ai compris : Fusion = Copie + Actualisation

Option Explicit
Sub CA()
  Dim W As Worksheet, C As Range, R As Range
  Set W = Sheets("Fusion")
  W.Cells.Clear
  Sheets("Salaires au 31 12").Cells.Copy W.[A1]
  With Sheets("Salaires actuels")
    For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
      Set R = W.[A:A].Find(C)
      If Not R Is Nothing Then
        If C(1, 2) = R(1, 2) And C(1, 3) = R(1, 3) Then
          C(1, 13).Resize(1, 2).Copy R(1, 18)
          C(1, 17).Copy R(1, 20)
        End If
      Else
        C.Resize(2, 20).Copy W.Cells(W.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
      End If
    Next
  End With
End Sub