Insérer ligne si ajout ligne ds autre tableau

Bonjour,

je débute en VBA et souhaitait pouvoir automatiser un process que je fais manuellement :

Tableau 1 :

Id | Statut | code

432 | OK | M45

543 | NOK | P98

123 | OK | T31

Tableau 2 :

Id | Statut | code

432 | OK | M45

543 | NOK | P98

Je voudrais ajouter une ligne et des colonnes associées ssi les valeurs du tableau 1 ne sont pas déjà référencé dans le tableau 2.

En sachant que :

  • ces 2 tableaux sont dans des onglets différents
  • le tableau 1 est maj régulièrement

Quand le tableau 1 a été maj, arriver à :

Tableau 2 :

Id | Statut | code

432 | OK | M45

543 | NOK | P98

123 | OK | T31

Et enfin, exporter un csv du tableau 2 uniquement des nouvelles lignes implémentées.

Si qqn peut m'aiguiller se sera super !!

Bonjour et bienvenu,

Ce serai plus facile avec un fichier d'exemple

Cordialement

en PJ, un fichier exemple sur lequel en fonction de vos retours je me baserai pour retravailler sur un fichier plus important

14differentiel.xlsm (10.48 Ko)

Re,

Voilà une solution, dites moi si ça vous convient

Cordialement

18differentiel.xlsm (23.08 Ko)

super, histoire de comprendre j'ai 2 modules, lequel est utilisé ? et succinctement tu pourrais m'expliquer ce que les lignes font.

Mais déjà merci merci !

module 1 :

Sub essai()
Dim cel As Range
Dim Nom As String
Dim Emplacement As Range
For Each cel In Sheets("Ancien").Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row)
Nom = cel.Value
Set Emplacement = Sheets("Recent").Cells.Find(Nom)
If Emplacement Is Nothing Then
Sheets("Ancien").Range(cel.Row & ":" & cel.Row).Copy
Sheets("Recent").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Sheets("Differentiel").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Else
End If
Next cel

'enregistrement fichier
Dim fichier As String
fichier = InputBox("Quel est le nom du fichier pour l'enregistrement ?")
    Sheets("Differentiel").Select
    Cells.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\Users\asus\Desktop\" & fichier & ".csv", _
        FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Save

End Sub

module 2 :

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveWorkbook.SaveAs Filename:="C:\Users\asus\Desktop\Differentiel.csv", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Application.WindowState = xlNormal
End Sub
Sub Macro2()
'
' Macro2 Macro
'

'
End Sub
Sub Macro3()
'
' Macro3 Macro
'

'
    Sheets("Differentiel").Select
    Cells.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\Users\asus\Desktop\Classeur1.csv", _
        FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub

Dsl,

Le second module, tu peux le supprimer, ceux sont mes essais (j'aurais dû les enlever)

ci-dessous, l'explication:

Sub essai()
'début de la macro
Dim cel As Range ' je déclare une variable "cel" comme étant une cellule (comme A1 si tu préfère)
Dim Nom As String ' je déclare une variable "Nom" comme étant une chaine de caractère (du texte en français)
Dim Emplacement As Range 'idem cel
For Each cel In Sheets("Ancien").Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row)
'c'est une boucle. littéralement : pour chaque cellule dans la feuille "Ancien" dans la plage de cellule qui va de B3 à -->compter les lignes,
 'remonter jusqu'a la dernière cellule non vide, donner le numéro de la ligne.
 'cette boucle va en fait appliquer la procédure suivante (jusqu'au next) pour chaque cellule de la plage B3  a la dernière cellule remplie
Nom = cel.Value ' Nom prend la valeur de la cellule actuelle soit le nom du produit (tableau 1)
Set Emplacement = Sheets("Recent").Cells.Find(Nom) ' ici, je recherche l'adresse de la cellule qui contient le nom du produit dans le tableau 2
If Emplacement Is Nothing Then 'si ne trouve pas l'emplacement -->c'est donc que ce produit n'existe pas dans le tableau 2
Sheets("Ancien").Range(cel.Row & ":" & cel.Row).Copy 'on copy donc la ligne du tableau 1
Sheets("Recent").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial 'on la colle dans le tableau 2
Sheets("Differentiel").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial ' et dans le tableau 3 (pour le csv)
Else 'sinon (si trouve l'emplacement) --> c'est donc que ce produit existe dans le tableau 2
'alors on ne fait rien
End If 'fin de la boucle si
Next cel 'passer à la référence du produit suivante

'enregistrement fichier
Dim fichier As String 'déclaration de variable
fichier = InputBox("Quel est le nom du fichier pour l'enregistrement ?") 'afficher une boite de dialogue pour demander le nom du fichier --> stocker la réponse dans la variable fichier
    Sheets("Differentiel").Select 'selectionner la feuille 3
    Cells.Select 'selectionner toutes les cellules
    Selection.Copy 'tout copier
    Workbooks.Add 'creer un nouveau fichier
    ActiveSheet.Paste 'dans la feuille active (du nouveau fichier donc), coller les cellules copiées
    Application.CutCopyMode = False 
    ActiveWorkbook.SaveAs Filename:="C:\Users\asus\Desktop\" & fichier & ".csv", _ 'enregistrer le fichier sur le bureau (avec le nom demandé précédement)
        FileFormat:=xlCSV, CreateBackup:=False 'enregister en csv
    ActiveWorkbook.Save 'sauvegarder le nouveau fichier (faculattif)
End Sub

Si vous avez d'autres questions, n'hésitez pas !

cordialement

TOP merci

j'ai essayé de l'appliquer sur mon document TEST, en cherchant par ma référence (colonne M), j'ai la macro qui se fait mais le fichier est vide alors qu'il ne devrait pas

peut-être est-ce le fait que mon tableau contienne des formules au lieu des données sur le premier document inital

Re,

effectivement, vous avecz des données jusqu'à la 10000eme ligne ce qui change les code de type .end(Xlup)

Voila le code modifié

Sub COMMANDE()
Dim cel As Range
Dim Nom As String
Dim Emplacement As Range
Dim Destination As Range
Dim nb As Long

nb = Sheets("Ancien").Range("M" & Rows.Count).End(xlUp).Row
For Each cel In Sheets("Ancien").Range("M2:M" & nb)
Nom = cel.Value
Set Emplacement = Sheets("Recent").Cells.Find(Nom)
If Emplacement Is Nothing Then
Sheets("Ancien").Range(cel.Row & ":" & cel.Row).Copy
Set Destination = Sheets("Recent").Range("M1").End(xlDown).Offset(1, 0)
Range(Destination.Row & ":" & Destination.Row).PasteSpecial
Sheets("Differentiel").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Else
End If
Next cel

'enregistrement fichier
Dim fichier As String
fichier = InputBox("Quel est le nom du fichier pour l'enregistrement ?")
    Sheets("Differentiel").Select
    Cells.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\Users\U786253\Desktop\" & fichier & ".csv", _
        FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Save

End Sub

Cordialement

quand je lance la macro, je n'ai plus les mêmes résultats escomptés qu'on avait avec le fichier excel basique

les nouvelles entrées issus de "ancien" ne s'ajoute plus dans "recent"

et le "diferrentiel" 'affiche désormais des lignes issus du "ancien" qui ne sont pas de nouvelles entrées

Rechercher des sujets similaires à "inserer ligne ajout tableau"