Manque copie d une cellule
Bonsoir.
Voilà j'ai un tableau qui est fait avec plusieurs macros.
Je travaille sur les doublons qui se dédoublent.
Ca fonctionne bien mais il me manque les données de la colonne M.
Les données des colonnes B et C sont blanches c 'est normales mais remplies.
Les données de la colonnes M sont à chercher dans la colonne F ou 6 de la feuille X3.
Je cherche à modifier la macro ci dessous mais après des tests ca ne fonctionne pas.
La macro est Recherchedoublon j'ai mis un bouton CLIQUER ICI pour que vous testiez.
Sub RechercheDoublon()
Dim i&, j%, K%, Derlg&, DerlgX3&, Lg&, Trouvé%, Mot() As Variant, X3 As Worksheet
Set X3 = Sheets("X3")
Derlg = Range("B" & Rows.Count).End(xlUp).Row
DerlgX3 = X3.Range("G" & Rows.Count).End(xlUp).Row
For i = 2 To Derlg
If Cells(i, 7) = "R" Or Cells(i, 7) = "r" Then Cells(i, 7) = "Rupture"
Erase Mot
Trouvé = 0
For K = 2 To DerlgX3
If Cells(i, 2) = X3.Cells(K, 7) Then ' 1
If Trouvé = 0 Then ' 2
ReDim Preserve Mot(0, 8)
Mot(0, 1) = X3.Cells(K, 7) ' code
Mot(0, 2) = X3.Cells(K, 8) ' désignation
Mot(0, 3) = X3.Cells(K, 16) ' statut prépa
Mot(0, 4) = X3.Cells(K, 9) ' Qté commandée recep
Mot(0, 5) = X3.Cells(K, 10) ' Qté Prép
Mot(0, 7) = K
Trouvé = 1
Else ' 2
If Trouvé = 1 Then
Cells(i, 1) = "< DOUBLON >"
Cells(i, 11) = ""
Cells(i, 12) = ""
InsererBlanc Cells(i, 3)
End If
Lg = Range("c" & Rows.Count).End(xlUp).Row + 1
Cells(Lg, 2).Font.Color = Cells(Lg, 2).Interior.Color
Cells(Lg, 2) = X3.Cells(K, 7) ' code
Cells(Lg, 3).Font.Color = Cells(Lg, 3).Interior.Color
Cells(Lg, 3) = X3.Cells(K, 8) ' Désignation
Cells(Lg, 11) = X3.Cells(K, 9) ' Qté Commandée
Cells(Lg, 12) = X3.Cells(K, 10) ' Qté Traitée
Cells(i, 11) = CDbl(Cells(i, 11)) + CDbl(X3.Cells(K, 9)) ' Qté totale commandée
Cells(i, 12) = CDbl(Cells(i, 12)) + CDbl(X3.Cells(K, 10)) ' Qté totale Traitée
Trouvé = Trouvé + 1
End If ' 2
End If ' 1
Next K
If Trouvé > 1 Then
Lg = Range("c" & Rows.Count).End(xlUp).Row + 1
Cells(Lg, 2).Font.Color = Cells(Lg, 2).Interior.Color
Cells(Lg, 2) = Mot(0, 1)
Cells(Lg, 3).Font.Color = Cells(Lg, 3).Interior.Color
Cells(Lg, 3) = Mot(0, 2)
Cells(Lg, 11) = Mot(0, 4)
Cells(Lg, 12) = Mot(0, 5)
Cells(i, 11) = CDbl(Cells(i, 11)) + CDbl(Mot(0, 4)) ' Qté totale commandée
Cells(i, 12) = CDbl(Cells(i, 12)) + CDbl(Mot(0, 5)) ' Qté totale Traitée
End If
Next i
Set X3 = Nothing
End Sub
Y aurait-il une personne qui arriverait à me programmer cela? Merci beaucoup.
Bien cordialement
