Dynamique offset

bonsoir ,

il ya quelques temps une personne dans se forum m'aider pour une macro , et je reviens vers le forum pour de l'aide encore une fois.

j'utilise le code suivant pour trouver et déplacer les doublons .

ActiveSheet.UsedRange

  LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row
  lastcolumn = StartCell.SpecialCells(xlCellTypeLastCell).Column

    Dim rngData As Range, ACell As Range, Cell As Range
Dim I As Long, J As Long, n As Long

    Set rngData = Range(StartCell, sht.Cells(LastRow, lastcolumn))

    For I = LastRow To 1 Step -1
        For J = lastcolumn To 1 Step -1
            Set ACell = rngData.Cells(I, J)

            For Each Cell In rngData
                If Cell <> Empty And _
                   Cell.Value = ACell.Value And _
                   Cell.Address <> ACell.Address Then

                    Cell.Cut Destination:=Cell.Offset(0, 8)
                    ACell.ClearContents

                    n = n + 1
                End If
            Next Cell
        Next J
    Next I

par exemple , j'ai 2 ligne de numéro ,

19 49 50 38

48 16 01 19

le code va déplacer la premier cellules dans la premiere ligne (un doublon de la ligne 2) de A1 a A8

49 50 38 19

48 16 01

37 16 19 02

le code va déplacer la cellule A8 a A16 parce que c'est un doublon de la ligne 3 ,ainsi que le numero 16 de b2 a b10.

se que je veux modifier

au lieu de déplacer la cellules A1 a A8 , je veux que la macro deplace la cellule B4 a B12 ( le premier exemple)

et la cellules C3 a C19 parce que le doublon est dans la cellules B12.

ya un fichier en pièce jointes qui explique avec des couleur et des feuilles par étape se que je veux .

Merci pour l'aide et désolé pour mon français mediocre

Salut zouhair_psi,

à tester, grandeur nature!

'
Dim tTab1, tTab2
iRow = Cells(Rows.Count, 1).End(xlUp).Row
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
For x = 2 To iRow
    tTab1 = Range("A" & x & ":" & "G" & x)
    For k = 1 To 7
        iCol = 1
        Do
            iFlag = iCol
            sCol1 = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
            sCol2 = Split(Columns(iCol + 6).Address(ColumnAbsolute:=False), ":")(1)
            tTab2 = Range(sCol1 & "1:" & sCol2 & x - 1)
            iOK = 0
            For y = 1 To UBound(tTab2, 1)
                For Z = 1 To UBound(tTab2, 2)
                    If tTab2(y, Z) = tTab1(1, k) And (tTab1(1, k) <> "" And tTab2(y, Z) <> "") Then
                        tTab2(y, Z) = ""
                        Cells(x, iCol + 7 + k) = tTab1(1, k)
                        tTab1(1, k) = ""
                        iOK = 1
                        Exit For
                    End If
                Next
                If iOK = 1 Then Exit For
            Next
            Range("A" & x & ":" & "G" & x) = tTab1
            Range(sCol1 & "1:" & sCol2 & x - 1) = tTab2
            If UsedRange.Columns.Count > iFlag Then iCol = iFlag + 8
        Loop Until iCol = iFlag
    Next
Next
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'

A+

c'est parfait , Merci BCP

Bonjour ,

je veux ajouter une boucle et d'autre petit macro avec votre macro , mais ca marche pas .

j'ai une erreur dans cette ligne

If UsedRange.Columns.Count > iFlag Then iCol = iFlag + 8

votre macro marche seulement lorsqu'il est associé a la feuille de calcul .

et comme je suis nouveau dans les macro et l'excel , je sais pas comment le modifier .

Merci

j'ai changé privé a public

j'ai modifié usedrange par If Range(StartCell, sht.cells(Lastrow, lastcolumn)).Columns.Count > iFlag Then iCol = iFlag + 8

je veux changé la couleur de iflag mais iflag.interior.color ne marche pas.

Merci

Salut zouhair_psi,

iFlag est une variable!!!

Explique ce que tu veux faire avec un fichier, stp!

A+

Bonjour et merci pour votre disponibilité.

Le code tTab2(y, Z) = "" supprime les cellules en double. jaimerai bien apres ,ajouter une couleur au cellules supprimer

Seulement les cellules en relation avec ttab2

J'ai essayé ceci

Cells (tTab2(y, Z)).interior.color = vbred

Mais ça marche pas

J'ai essayé aussi

Redrng as range

Puis set redrng = ttab2

Redrng.interior.color= vbred

Ça marche pas aussi.

Salut Zouhair,

ceci peut-être? A placer après tTab2(y, Z) = ""

Cells(y, (iCol - 1) + Z).Interior.Color = RGB(255, 0, 0)

A+

Merci bcp.