Décaler une selection de cellule grâce à VBA

Bonjour,

Je suis stagiaire dans un service réglementaire et je suis confronté à un problème qui, je suis sûr peut être résolu via VBA.

Voici mon problème : je dois réunir via un clef qu'on appellera ici "CCG" 2 tableaux quasiment identiques mais de dates différentes. D'une date à l'autre la valeur qui suit la clef CCG bouge, et je cherche à trouver ces variations. Il me suffirait de copier/coller les 2 tableaux côtes a côtes pour chercher les différences via une soustraction si entre 2 dates si le nombre de CCG ne bougeait pas (création et suppression). J'ai joint un schéma du tableau avec lequel je travail. Je cherche donc à décaler en fonction du numéro CCG (donné dans un ordre croissant) les cellules qui ne sont pas égales, pour avoir au final tous les nombres CCG dans 2 tableaux avec leur intitulé (ici j'ai seulement laissé la devise) dans les 2 colonnes. Ainsi je ne perdrais pas de CCG en chemin et pourrait comparer les bon montants face à face...

J'ai commencé à travailler sur VBA en prenant en compte l'ordre croissant du CCG, mais ma problématique n'est pas toute simple...

Merci d'avance pour votre aide !

Bonjour,

une proposition via une macro

Sub aargh()
    Set ws1 = Worksheets.Add
    Set ws2 = Sheets("feuil2")
    ws2.Rows("1:2").Copy ws1.Rows(1)
    i1 = 3
    i2 = 3
    i3 = 2
    While Not (fin1 And fin2)
        If Not fin1 Then k1 = ws2.Cells(i1, "C"): If k1 = "" Then k1 = ws2.Cells(i1 - 1, "G"): fin1 = True
        If Not fin2 Then k2 = ws2.Cells(i2, "H"): If k2 = "" Then k2 = ws2.Cells(i2 - 1, "G"): fin2 = True
        i3 = i3 + 1
        If k1 = k2 Then
            ws2.Range("A" & i1 & ":E" & i1).Copy ws1.Cells(i3, 1)
            ws2.Range("F" & i2 & ":I" & i2).Copy ws1.Cells(i3, 6)
            i1 = i1 + 1
            i2 = i2 + 1
        ElseIf k1 < k2 Then
            ws2.Range("A" & i1 & ":E" & i1).Copy ws1.Cells(i3, 1)
            i1 = i1 + 1
        Else
            ws2.Range("E" & i2 & ":I" & i2).Copy ws1.Cells(i3, 5)
            i2 = i2 + 1
        End If
    Wend
    ws1.Columns.AutoFit
End Sub

Bonjour h2so4,

Merci beaucoup pour cette première réponse aussi rapide ! En effet ta macro marche bien seulement elle ne recopie pas les données textes (devise et numéro) lorsqu'elle décale la première. Est-ce possible de copier l'énoncé de celle existante dans l'un des 2 arrêtés et de le recopier dans l'autre arrêté qui ne possède pas ce chiffre CCG ?

Encore merci grâce a toi j'ai déjà pu avancer.

Amateur de VBA

bonjour,

peux-tu reformuler au mettre un exemple de ce que tu veux ? j'ai rien compris.

Haha oui bien entendu.

Je t'ai mentionné les lignes avec un petit soucis dans la Feuil1.

re-bonjour,

une nouvelle proposition

Sub décaler()
    Set ws1 = Worksheets.Add
    Set ws2 = Sheets("feuil2")
    ws2.Rows("1:2").Copy ws1.Rows(1)
    i1 = 3
    i2 = 3
    i3 = 2
    k1 = ws2.Cells(i1, "C")
    k2 = ws2.Cells(i2, "H")
    While Not (fin1 And fin2)
        i3 = i3 + 1
        If k1 = k2 Then
            ws2.Range("A" & i1 & ":E" & i1).Copy ws1.Cells(i3, 1)
            ws2.Range("F" & i2 & ":I" & i2).Copy ws1.Cells(i3, 6)
            i1 = i1 + 1
            i2 = i2 + 1
            ws1.Cells(i3, 10) = "ok"
        Else
            ws1.Cells(i3, 10) = "NON"
            If k1 < k2 Then
                ws2.Range("A" & i1 & ":E" & i1).Copy ws1.Cells(i3, 1)
                ws2.Range("C" & i1).Copy ws1.Cells(i3, 8)
                i1 = i1 + 1
            Else
                ws2.Range("E" & i2 & ":I" & i2).Copy ws1.Cells(i3, 5)
                ws2.Range("H" & i2).Copy ws1.Cells(i3, 3)
                i2 = i2 + 1
            End If
        End If
        If Not fin1 Then k1 = ws2.Cells(i1, "C"): If k1 = "" Then k1 = ws2.Cells(i1 - 1, "G"): fin1 = True
        If Not fin2 Then k2 = ws2.Cells(i2, "H"): If k2 = "" Then k2 = ws2.Cells(i2 - 1, "G"): fin2 = True
    Wend
    ws1.Columns.AutoFit
End Sub

re-bonjour,

C'est presque parfait haha, tu peux rajouter les autres données que le numéro à copier stp ? La date d'arrêté et la devise

re-bonjour

Sub décaler()
    Set ws1 = Worksheets.Add
    Set ws2 = Sheets("feuil2")
    ws2.Rows("1:2").Copy ws1.Rows(1)
    i1 = 3
    i2 = 3
    i3 = 2
    k1 = ws2.Cells(i1, "C")
    k2 = ws2.Cells(i2, "H")
    While Not (fin1 And fin2)
        i3 = i3 + 1
        If k1 = k2 Then
            ws2.Range("A" & i1 & ":E" & i1).Copy ws1.Cells(i3, 1)
            ws2.Range("F" & i2 & ":I" & i2).Copy ws1.Cells(i3, 6)
            i1 = i1 + 1
            i2 = i2 + 1
            ws1.Cells(i3, 10) = "ok"
        Else
            ws1.Cells(i3, 10) = "NON"
            If k1 < k2 Then
                ws2.Range("A" & i1 & ":E" & i1).Copy ws1.Cells(i3, 1)
                ws2.Range("A" & i1 & ":C" & i1).Copy ws1.Cells(i3, 6)
                i1 = i1 + 1
            Else
                ws2.Range("E" & i2 & ":I" & i2).Copy ws1.Cells(i3, 5)
                ws2.Range("F" & i2 & ":I" & i2).Copy ws1.Cells(i3, 1)
                i2 = i2 + 1
            End If
        End If
        If Not fin1 Then k1 = ws2.Cells(i1, "C"): If k1 = "" Then k1 = ws2.Cells(i1 - 1, "G"): fin1 = True
        If Not fin2 Then k2 = ws2.Cells(i2, "H"): If k2 = "" Then k2 = ws2.Cells(i2 - 1, "G"): fin2 = True
    Wend
    ws1.Columns.AutoFit
End Sub

re-bonjour,

Merci beaucoup ta formule marche parfaitement ! Je la test en la modifiant sur mon fichier de base.

Encore merci tu m'as été d'une grande aide. Je valide ta réponse quand j'aurais réussie à modifier ta requête de base sur mon fichier.

A bientôt

Une dernière fois merci pour ton aide si efficiente.

Bonne continuation !