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