insérer ligne si ajout ligne ds autre tableau Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
m
margaux_bthm
Nouveau venu
Nouveau venu
Messages : 8
Appréciation reçue : 1
Inscrit le : 30 mai 2018
Version d'Excel : 2010

Message par margaux_bthm » 30 mai 2018, 12:31

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 !!
Avatar du membre
besoin_d_aide
Membre fidèle
Membre fidèle
Messages : 325
Appréciations reçues : 28
Inscrit le : 16 mai 2018
Version d'Excel : 2010 fr, 2013 fr, 2016 fr

Message par besoin_d_aide » 30 mai 2018, 15:54

Bonjour et bienvenu,
Ce serai plus facile avec un fichier d'exemple :wink:

Cordialement
" Notre sagesse n'est que le total de nos désillusions. " Henri-Frédéric Amiel
Je peux répondre aux messages privés mais c'est mieux si la solution est disponible pour tous ;;)
Mais surtout, le plus important : :btres:
m
margaux_bthm
Nouveau venu
Nouveau venu
Messages : 8
Appréciation reçue : 1
Inscrit le : 30 mai 2018
Version d'Excel : 2010

Message par margaux_bthm » 30 mai 2018, 16:09

en PJ, un fichier exemple sur lequel en fonction de vos retours je me baserai pour retravailler sur un fichier plus important
Differentiel.xlsm
(10.48 Kio) Téléchargé 9 fois
1 membre du forum aime ce message.
Avatar du membre
besoin_d_aide
Membre fidèle
Membre fidèle
Messages : 325
Appréciations reçues : 28
Inscrit le : 16 mai 2018
Version d'Excel : 2010 fr, 2013 fr, 2016 fr

Message par besoin_d_aide » 30 mai 2018, 16:37

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

Cordialement
Differentiel.xlsm
(23.08 Kio) Téléchargé 15 fois
" Notre sagesse n'est que le total de nos désillusions. " Henri-Frédéric Amiel
Je peux répondre aux messages privés mais c'est mieux si la solution est disponible pour tous ;;)
Mais surtout, le plus important : :btres:
m
margaux_bthm
Nouveau venu
Nouveau venu
Messages : 8
Appréciation reçue : 1
Inscrit le : 30 mai 2018
Version d'Excel : 2010

Message par margaux_bthm » 30 mai 2018, 16:47

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
Avatar du membre
besoin_d_aide
Membre fidèle
Membre fidèle
Messages : 325
Appréciations reçues : 28
Inscrit le : 16 mai 2018
Version d'Excel : 2010 fr, 2013 fr, 2016 fr

Message par besoin_d_aide » 30 mai 2018, 18:17

Dsl,

Le second module, tu peux le supprimer, ceux sont mes essais (j'aurais dû les enlever) :lol:
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
" Notre sagesse n'est que le total de nos désillusions. " Henri-Frédéric Amiel
Je peux répondre aux messages privés mais c'est mieux si la solution est disponible pour tous ;;)
Mais surtout, le plus important : :btres:
m
margaux_bthm
Nouveau venu
Nouveau venu
Messages : 8
Appréciation reçue : 1
Inscrit le : 30 mai 2018
Version d'Excel : 2010

Message par margaux_bthm » 31 mai 2018, 09:56

:mrgreen: TOP merci
m
margaux_bthm
Nouveau venu
Nouveau venu
Messages : 8
Appréciation reçue : 1
Inscrit le : 30 mai 2018
Version d'Excel : 2010

Message par margaux_bthm » 31 mai 2018, 15:28

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
Avatar du membre
besoin_d_aide
Membre fidèle
Membre fidèle
Messages : 325
Appréciations reçues : 28
Inscrit le : 16 mai 2018
Version d'Excel : 2010 fr, 2013 fr, 2016 fr

Message par besoin_d_aide » 31 mai 2018, 16:02

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
" Notre sagesse n'est que le total de nos désillusions. " Henri-Frédéric Amiel
Je peux répondre aux messages privés mais c'est mieux si la solution est disponible pour tous ;;)
Mais surtout, le plus important : :btres:
m
margaux_bthm
Nouveau venu
Nouveau venu
Messages : 8
Appréciation reçue : 1
Inscrit le : 30 mai 2018
Version d'Excel : 2010

Message par margaux_bthm » 31 mai 2018, 16:50

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

:bof:
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message