Import boucle à 2 variables même ligne

Bonjour, je cherche à améliorer une macro s'il vous plaît,

Actuellement :

Boucle pour importer chaque ligne

Si dans la ligne, la valeur de num1 est déjà présente alors : remplacement de la ligne par la nouvelle

Sinon : Rajout de la ligne à la fin

Objectif :

Boucle pour importer chaque ligne

Si dans la ligne, la valeur de num1 est déjà présente ET que num2 (nouvelle variable) aussi (sur la même ligne) alors : remplacement de la ligne par la nouvelle

Sinon : Rajout de la ligne à la fin

Dim Numligne1 As Integer

Dim Recligne As Integer

Numligne1 = 2

Do While Cells(Numligne1, 1) <> Empty

If Application.WorksheetFunction.CountIf(Range("Tableau1[Nb1 '#]"), Range("A" & Numligne1)) > 0 Then

Range("A" & Numligne1 & ":N" & Numligne1).Copy

Recligne = Application.WorksheetFunction.Match(Range("A" & Numligne1).Value, Range("Tableau1[Nb1 '#]"), 0) + 1

Feuil4.Select

Range("A" & Recligne).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Else

Range("A" & Numligne1 & ":N" & Numligne1).Copy

Feuil4.Select

Range("A65536").End(xlUp).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

End If

Sheets("DATA (2)").Select

Numligne1 = Numligne1 + 1

Loop

Bonjour,

ça irait mieux avec un fichier excel

aussi à quoi correspond la variable num1 ?

Bonjour,

Le classeur en est PJ,

La variable num1 correspond au numéro de ligne de la colonne A (utiliser en loop ==> dès que cellule vide alors s'arrete ; et dans l'equiv pour les correspondances)

Il y a plus d'explication dans le VBA

Merci pour votre aide !

re,

à tester,

Sub remplissage()
Dim Numligne1 As Integer
Dim Recligne As Integer

Set sh1 = Sheets("CRITICAL")
Set sh2 = Sheets("CRIT DATA")

Numligne1 = 2

Do While sh1.Cells(Numligne1, 1) <> Empty

        If Not IsError(Application.Match(sh1.Range("A" & Numligne1), sh2.Range("A:A"), 0)) Then
        'Si numéro de dossier déjà existant alors'
            k = Application.Match(sh1.Range("A" & Numligne1), sh2.Range("A:A"), 0)
            sh2.Range("A" & k & ":N" & k).Value = sh1.Range("A" & Numligne1 & ":N" & Numligne1).Value
        'sinon
        Else
            k = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            sh2.Range("A" & k & ":N" & k).Value = sh1.Range("A" & Numligne1 & ":N" & Numligne1).Value
        End If

        Numligne1 = Numligne1 + 1

Loop
End Sub

re,

une autre version pour tenir compte du PO Number

Sub remplissage()
Dim Numligne1 As Integer
Dim Recligne As Integer

Set sh1 = Sheets("CRITICAL")
Set sh2 = Sheets("CRIT DATA")

Numligne1 = 2

Do While sh1.Cells(Numligne1, 1) <> Empty
Debug.Print sh1.Range("A" & Numligne1)
        If Not IsError(Application.Match(sh1.Range("A" & Numligne1), sh2.Range("A:A"), 0)) Then
        'Si numéro de dossier déjà existant alors'
            k = Application.Match(sh1.Range("A" & Numligne1), sh2.Range("A:A"), 0)
         'Si numéro de Po est différent alors n=1'
            If Not sh1.Range("E" & Numligne1) = sh2.Range("E" & k) Then n = 1 Else n = 0
        End If

        If Not IsError(k) And n = 0 Then
             sh2.Range("A" & k & ":N" & k).Value = sh1.Range("A" & Numligne1 & ":N" & Numligne1).Value

        'sinon
        Else
            k = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            sh2.Range("A" & k & ":N" & k).Value = sh1.Range("A" & Numligne1 & ":N" & Numligne1).Value
        End If

        Numligne1 = Numligne1 + 1

Loop
End Sub