XL 2013 Importation conditionnelle

an@s · 19 Janvier 2021

Bonjour à tous,

je reviens vers vous pour la problématique suivante :

1- Je veux créer un code dans la feuille Omega du classeur Balance qui permet d'importer toutes les données du classeur Omega sauf la colonne E et à partir de la ligne 2 et les coller dans la feuille Omega de la feuille Balance à partir de la ligne 7 avec la condition suivante :
importer juste les lignes du classeur omega dont les cellules de la colonne C égale Entier ou Dechet

2- J'aimerais avoir un 2ème code qui permet d'importer les données du classeur Canico de la colonne A jusqu'à la colonne J et à partir de la ligne 7 en excluant aussi la ligne total Numéro 20 et les coller dans la feuille Canico du classeur Balance à partir de la ligne 7 avec la condition suivante :
si le code détecte dans la colonne C du classeur Canico des numéros de bons identique il doit rassembler les quantités des colonnes I et J et les coller en une seule ligne dans Canico du classeur Balance comme l'exemple des lignes 9 et 10 puis 14 et 15,

Je vous remercie pour votre aide

job75 · 19 Janvier 2021

Bonsoir an@s,

Téléchargez les fichiers joints dans le même dossier (le bureau()

Ouvrez le fichier .xlsm et testez les macros des 2 boutons :

VB:

Sub Import_Omega()
Dim fichier$, F As Worksheet
fichier = ThisWorkbook.Path & "\Omega.xlsx"
If Dir(fichier) = "" Then MsgBox "Fichier Omega.xlsx introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Set F = Sheets("Omega")
F.Range("A6:D" & F.Rows.Count).Delete xlUp 'RAZ
With Workbooks.Open(fichier).Sheets(1) 'ouvre le fichier
    .Columns("E").Delete
    With .[A1].CurrentRegion
        .AutoFilter 3, "Entier", xlOr, "Dechet" 'filtre automatique
        .Copy F.[A6] 'copier-coller
    End With
    .Parent.Close False 'ferme le fichier
End With
End Sub

Sub Import_Canico()
Dim fichier$, F As Worksheet, i&
fichier = ThisWorkbook.Path & "\Canico.xlsx"
If Dir(fichier) = "" Then MsgBox "Fichier Canico.xlsx introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set F = Sheets("Canico")
F.Range("A6:I" & F.Rows.Count).Delete xlUp 'RAZ
With Workbooks.Open(fichier).Sheets(1) 'ouvre le fichier
    With .[A6].CurrentRegion.Resize(, 10)
        .Rows(.Rows.Count).Delete
        .Columns(4).UnMerge 'défusionne les cellules
        .Columns(5).Delete xlToLeft
        .Sort .Columns(3), xlAscending, Header:=xlYes 'tri sur la colonne C
        For i = .Rows.Count To 2 Step -1
            If .Cells(i - 1, 3) = .Cells(i, 3) Then
                .Cells(i - 1, 8) = .Cells(i - 1, 8) + .Cells(i, 8) 'consolide
                .Cells(i - 1, 9) = .Cells(i - 1, 9) + .Cells(i, 9) 'consolide
                .Rows(i).Delete xlUp 'supprime la ligne doublon
            End If
        Next
        .Copy F.[A6] 'copier-coller
    End With
    .Parent.Close False 'ferme le fichier
End With
End Sub

A+

an@s · 20 Janvier 2021

Bonsoir Mr Job,

Je vous remercie pour votre réponse et surtout pour votre excellent travail habituel,
après un test je confirme que c'est bien ce que je voulais comme résultat.

maintenant j'aimerais avoir un 3ème et dernier code dans la feuille RECAP qui permet de copier les données de la colonne C , F, G et H de la feuille Canico du classeur Balance vers la colonne A, B C et D de la feuille Reca,
puis copier les données de la Colonne D de la feuille Omega vers la colonne E de la feuille RECAP en divisant les valeurs sur 1000 (exemple D7 de la feuille Omega est 2650, pour la copier dans la colonne E il faut la diviser sur 1000 et mettre 26,50).
et pour finir la code doit calculer la différence dans la colonne F entre D et E de la feuille RECAP et mettre le résultat dans la colonne F sans montrer la formule.

Je vous remercie encore une autre fois,

job75 · 20 Janvier 2021

Bonjour an@s,

La correspondance indiquée pour définir les colonnes de la feuille RECAP ne va pas du tout.

Joignez un fichier avec une feuille RECAP correcte et redonnez la correspondance.

A+

an@s · 20 Janvier 2021

Bonjour Mr Job,

Désolé j'ai oublié la colonne Article
voici le fichier avec la feuille RECAP rectifiée et les données insérées manuellement,

Je vous remercie

job75 · 20 Janvier 2021

Fichier (2) avec ce code dans la feuille RECAP :

VB:

Private Sub Worksheet_Activate()
Dim derlig&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Import_Omega
Import_Canico
Range("A7:F" & Rows.Count).Delete xlUp 'RAZ
With Sheets("Canico")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    derlig = .Range("C" & .Rows.Count).End(xlUp).Row
    If derlig < 7 Then GoTo 1 'si le tableau est vide
    Range("A7:A" & derlig) = .Range("C7:C" & derlig).Value
    Range("B7:D" & derlig) = .Range("F7:H" & derlig).Value
End With
Range("E7:E" & derlig) = "=IFERROR(VLOOKUP(A7,Omega!A:D,4,0)/1000,"""")" 'Poids Net
Range("F7:F" & derlig) = "=D7-E7" 'Ecart
Range("E7:F" & derlig) = Range("E7:F" & derlig).Value 'supprime les formules
Range("A7:F" & derlig).Borders.Weight = xlThin 'bordures
1 Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A7:F" & Rows.Count)) Is Nothing Then Worksheet_Activate 'lance la macro
End Sub

Il s'exécute quand on active la feuille ou quand on modifie une cellule, c'est mieux qu'un bouton.

an@s · 20 Janvier 2021

Re-Bonjour Mr Job,

c'est juste parfait comme résultat,
en revanche comme vous pouvez voir dans le fichier joint si un N° de bon existe dans la feuille Omega et n'existe pas dans Canico la cellule F18 renvoie une erreur,
1-je ne sais pas si ce serait possible dans ce cas avoir dans E18= n'existe pas et dans F18=26?

2-puis j'ai remarqué que je ne peux pas modifier dans les tableaux des feuilles Canico et Omega, parce quand je change une valeur une fois je clique sur RECAP le tableau reprend la valeur d'origine importée. normalement si je modifie quoi que ce soit sur Canico ou Omega du classeur Balance le tableau de RECAP doit le prendre en considération au lieu de reprendre la valeur d'origine.

Merci beaucoup encore une autre fois

job75 · 20 Janvier 2021

Voyez ce fichier (3).

1- j'ai modifié la formule des écarts en colonne F :

VB:

Range("F7:F" & derlig) = "=IFERROR(D7-E7,"""")" 'Ecart

2- les tableaux des feuilles Omega et Canico doivent impérativement correspondre aux fichiers sources, j'ai donc modifié les codes des boutons : si le fichier n'est pas trouvé le tableau est vidé.

an@s · 20 Janvier 2021

pour le fichier 3 :

1- la formule ne donne pas le résultat souhaité :
si D18 ou E18 n'existe pas dans le tableau initial il faut écrire dans D18 ou E18 le mot ""N'existe pas"",
ensuite dans F18 il faut mettre D18-E18, dans notre cas D18 existe donc dans F18 il faut mettre 26,
(si D18 n'existe pas et E18 egale par exemple 26 dans F18 le code doit mettre -26)

2- c'est Ok pour ce point

Je vous remercie

job75 · 20 Janvier 2021

Tout cela me paraît inutilement compliqué mais bon voyez ce fichier (4) :

VB:

Private Sub Worksheet_Activate(): End
Dim derlig&
Application.EnableEvents = False 'désactive les évènements
Import_Omega
Import_Canico
Range("A7:F" & Rows.Count).Delete xlUp 'RAZ
With Sheets("Canico")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    derlig = .Range("C" & .Rows.Count).End(xlUp).Row
    If derlig < 7 Then GoTo 1 'si le tableau est vide
    Range("A7:A" & derlig) = .Range("C7:C" & derlig).Value
    Range("B7:C" & derlig) = .Range("F7:G" & derlig).Value
End With
Range("D7:D" & derlig) = "=IF(Canico!H7="""",""N'existe pas"",Canico!H7)"
Range("E7:E" & derlig) = "=IFERROR(VLOOKUP(A7,Omega!A:D,4,0)/1000,""N'existe pas"")" 'Poids Net
Range("F7:F" & derlig) = "=IFERROR(D7-E7,26)" 'Ecart
Range("D7:F" & derlig) = Range("D7:F" & derlig).Value 'supprime les formules
Range("A7:F" & derlig).Borders.Weight = xlThin 'bordures
1 Application.EnableEvents = True 'réactive les évènements
End Sub

Si les formules ne vous conviennent pas modifiez-les, j'en ai ras le bol, il fallait être plus précis.

an@s · 20 Janvier 2021

Bonsoir Mr Job,

Merci beaucoup pour la rectification,
C'est tout à fait ce que je souhaitais comme résultat.

Amicalement,

XL 2013 Importation conditionnelle

an@s

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

an@s

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

an@s

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

an@s

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

an@s

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

an@s

XLDnaute Occasionnel

Discussions similaires