Copier Pls Lignes de pls fichiers vers 1 seul sous condition. [Résolu]

Question

Posez votre question Signaler

Copier Pls Lignes de pls fichiers vers 1 seul sous condition. [Résolu]

Trophinou

Messages postés: 23
Date d'inscription: vendredi 13 juillet 2012
Statut: Membre
Dernière intervention: 26 mars 2014

- 21 mars 2014 à 10:34 - Dernière réponse : Trophinou

Messages postés: 23
Date d'inscription: vendredi 13 juillet 2012
Statut: Membre
Dernière intervention: 26 mars 2014

- 23 mars 2014 à 00:41

VBA Office (Excel, Word ...) Posez votre question Signaler

Bonjour à tous.

Je suis sous excel 2003 (windows Xp mais je doute que cela soit utile)
J'ai tenté de trouver des bouts de script à droite te à gauche, mais j'avoue que je n'y arrive pas. D'autre part l'échéance étant proche, j'ai hélas pas trop le temps de chercher par moi même.
D'autre par je ne sais pas si je poste dans la bonne rubrique si je me suis trompé, veuillez m'en excuser.

Voila mon souci.
J'ai 5 bordereaux de commandes avec plusieurs milliers de lignes chacun.
Tous selon le même modèle (à peu près) mais pas tous du même fournisseur.

N° référence | Description produit | Prix unitaire | Quantité | Prix selon la quantité

1. J'aimerai pouvoir copier toutes les lignes ou la quantité sera égale à 1 de tous les fichiers sur un seul et même 6 éme fichier. (fichier récapitulatif)
Via un bouton, car je pense que le faire au fil de la commande risque d'être beaucoup plus ardu.

2. Avant la copie des lignes Il faudrait que le nom du fournisseur apparaisse avec le nombre de lignes copiées.

exemple :
Nathan 8 lignes
et en dessous les 8 lignes de commandes retenues.

La victoire 5 lignes
et en dessous les 5 lignes de commandes retenues.

2bis / les 5 premières lignes du Fichier récapitulatif sont déjà prises pour l'entête personnalisée et la présentation.

D'autres conditions importantes

3/ Si je partage ce fichiers avec mes collègues (nous sommes 17) sur leur ordi pourront-ils si chemin il doit y avoir, retrouver les bonnes adresses de fichiers ?
Ou pour faciliter la chose, dois-je leur dire d'enregistrer le tout à un endroit bien précis?

4/ Nous ne connaissons pas encore notre budget.
Est-il possible d'associer une autre macro (sur un autre bouton) pour effacer les lignes copiées afin de recommencer les commandes ?

Pour le moment en copiant des bouts de code par ci par là j'ai tant bien que mal réussi à copier d'un feuillet sur un autre feuillet, mais je n'arrive pas à définir Les autres classeurs.
Et surtout je sais pas faire les copies à la suite...

Si vous avez des idées à mon casse tête, je suis preneur.

Si vous avez des informations complémentaires à demander, je suis aussi preneur.

Bonne journée et merci d'avance.

Trophinou

Afficher la suite

A voir également:

Papeterie la victoire
Papeteries la victoire - Meilleures réponses
Pls pharma - Meilleures réponses
Copier certaines lignes d'un memo vers un autre memo ✓ - Forum - Delphi / Pascal
Copier des lignes d'un memo vers un autre automatiquement ✓ - Forum - Delphi / Pascal
Copier certaines lignes d'un memo vers un autre memo ✓ - Forum - Delphi / Pascal
Copier le contenu d'un fichier vers un autre ! ✓ - Forum - C
Copier coller d'une feuillea de fichiera vers feuilleb de fichierb excel - Codes sources - Visual Basic / VB.NET (VBA)

Votre réponse

Répondre au sujet

6 réponses

Signaler Commenter la réponse de jordane45

jordane45

Messages postés: 25618
Date d'inscription: mercredi 22 octobre 2003
Statut: Modérateur
Dernière intervention: 26 mai 2019

311 21 mars 2014 à 11:00

0

Merci

Bonjour,

D'autre par je ne sais pas si je poste dans la bonne rubrique si je me suis trompé, veuillez m'en excuser.

Tu es pardonné.... :-) Sujet déplacé dans la section VBA

Signaler Commenter la réponse de Trophinou

Trophinou

Messages postés: 23
Date d'inscription: vendredi 13 juillet 2012
Statut: Membre
Dernière intervention: 26 mars 2014

21 mars 2014 à 12:17

0

Merci

Merci pour tes infos et dommage que vous ne fassiez pas tout à ma place. ;)

Première question.

Comment définir les 5 classeurs dans lesquels je vais aller prendre les lignes.

Je sais le faire pour des feuillets sur un même classeur, mais pas aller chercher sur d'autres classeurs.

La condition if je dois savoir le faire.

Merci

Signaler Commenter la réponse de Trophinou

Trophinou

Messages postés: 23
Date d'inscription: vendredi 13 juillet 2012
Statut: Membre
Dernière intervention: 26 mars 2014

Modifié par Trophinou le 22/03/2014 à 08:51

0

Merci

Coucou c'est remoi

Bon grace aux indices de Jordane voila ce que j'ai trouvé et pour le moment ça marche... (ouf!)

Ya que lorsque je veux effacer que ça m'efface par morceaux et je ne sais toujours pas pourquoi je dois cliquer pls fois sur le bouton pour effacer la totalité des lignes écrites précédemment.
Mais tant que ça marche c'est pas grave.

++

Troph



Sub Copie()
    Dim plage As Range, cel As Range
    Dim nom As String
    Dim x As String
    Application.ScreenUpdating = False
    
    'Nombre de lignes
    x = CDbl(Workbooks("Bordereau_Nathan_Sejers_2014.xls").Worksheets("Feuil1").Range("M2").Value) + CDbl(Workbooks("Bordereau de commande Papeterie La Victoire.xls").Worksheets("Feuil1").Range("J3").Value) + CDbl(Workbooks("Tarifs 2014 pour les 6-12 ans Wesco.xls").Worksheets("6-12 ans prix fort").Range("M15").Value) + CDbl(Workbooks("Tarifs  2014 pour les 0-6 ans Wesco.xls").Worksheets("Tarif").Range("L13").Value) + CDbl(Workbooks("Commandes pharmacie.xls").Worksheets("Consommables").Range("F6").Value) + CDbl(Workbooks("Commandes pharmacie.xls").Worksheets("produits").Range("F5").Value)
    Workbooks("Récap perso.xls").Worksheets("Feuil1").Range("B5").Value = x
    
    ' Nathan
    With Workbooks("Bordereau_Nathan_Sejers_2014.xls").Worksheets("Feuil1")
        derlig = .Range("L" & Rows.Count).End(xlUp).Row
        Set plage = .Range("L3:L" & derlig)
    End With
    
    For Each cel In plage
        If cel = 1 Then
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A8").Value = "nathan"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("B8").Value = "Nb de ref"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("C8").Value = Workbooks("Bordereau_Nathan_Sejers_2014.xls").Worksheets("Feuil1").Range("M2")
            cel.EntireRow.Copy
            Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A9").Select
            Selection.Insert Shift:=xlDown
        End If
    Next cel
    
    ' La victoire
    
    With Workbooks("Bordereau de commande Papeterie La Victoire.xls").Worksheets("Feuil1")
        derlig = .Range("I" & Rows.Count).End(xlUp).Row
        Set plage = .Range("I4:I" & derlig)
    End With
    N = 10 + Workbooks("Récap perso.xls").Worksheets("feuil1").Range("C8").Value
    For Each cel In plage
        If cel = 1 Then
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & N).Value = "La Victoire"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("B" & N).Value = "Nb de ref"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("C" & N).Value = Workbooks("Bordereau de commande Papeterie La Victoire.xls").Worksheets("Feuil1").Range("J3")
            cel.EntireRow.Copy
            Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & N + 1).Select
            Selection.Insert Shift:=xlDown
        End If
    Next cel
    
    
   ' Wesco 6 - 12
   
    With Workbooks("Tarifs 2014 pour les 6-12 ans Wesco.xls").Worksheets("6-12 ans prix fort")
        derlig = .Range("M" & Rows.Count).End(xlUp).Row
        Set plage = .Range("M16:I" & derlig)
    End With
   M = N + 2 + Workbooks("Bordereau de commande Papeterie La Victoire.xls").Worksheets("Feuil1").Range("J3")
   For Each cel In plage
        If cel = 1 Then
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & M).Value = "Wesco 6 - 12"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("B" & M).Value = "Nb de ref"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("C" & M).Value = Workbooks("Tarifs 2014 pour les 6-12 ans Wesco.xls").Worksheets("6-12 ans prix fort").Range("M15")
            cel.EntireRow.Copy
            Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & M + 1).Select
            Selection.Insert Shift:=xlDown
        End If
    Next cel
    
       ' Wesco 0 - 6
   
    With Workbooks("Tarifs  2014 pour les 0-6 ans Wesco.xls").Worksheets("Tarif")
        derlig = .Range("L" & Rows.Count).End(xlUp).Row
        Set plage = .Range("L14:L" & derlig)
    End With
   P = M + 2 + Workbooks("Tarifs 2014 pour les 6-12 ans Wesco.xls").Worksheets("6-12 ans prix fort").Range("M15")
   For Each cel In plage
        If cel = 1 Then
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & P).Value = "Wesco 6 - 12"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("B" & P).Value = "Nb de ref"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("C" & P).Value = Workbooks("Tarifs  2014 pour les 0-6 ans Wesco.xls").Worksheets("Tarif").Range("L13")
            cel.EntireRow.Copy
            Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & P + 1).Select
            Selection.Insert Shift:=xlDown
        End If
    Next cel
    
        ' Pharmacie conso
   
    With Workbooks("Commandes pharmacie.xls").Worksheets("consommables")
        derlig = .Range("E" & Rows.Count).End(xlUp).Row
        Set plage = .Range("E7:E" & derlig)
    End With
   Q = P + 2 + Workbooks("Tarifs  2014 pour les 0-6 ans Wesco.xls").Worksheets("Tarif").Range("L13")
   For Each cel In plage
        If cel = 1 Then
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & Q).Value = "Pharma Conso"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("B" & Q).Value = "Nb de ref"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("C" & Q).Value = Workbooks("Commandes pharmacie.xls").Worksheets("Consommables").Range("F6")
            cel.EntireRow.Copy
            Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & Q + 1).Select
            Selection.Insert Shift:=xlDown
        End If
    Next cel
    
    ' Pharmacie Produits
   
    With Workbooks("Commandes pharmacie.xls").Worksheets("produits")
        derlig = .Range("E" & Rows.Count).End(xlUp).Row
        Set plage = .Range("E6:E" & derlig)
    End With
  R = Q + 2 + Workbooks("Commandes pharmacie.xls").Worksheets("Consommables").Range("F6")
   For Each cel In plage
        If cel = 1 Then
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & R).Value = "Pharma Conso"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("B" & R).Value = "Nb de ref"
        Workbooks("Récap perso.xls").Worksheets("feuil1").Range("C" & R).Value = Workbooks("Commandes pharmacie.xls").Worksheets("produits").Range("F5")
            cel.EntireRow.Copy
            Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A" & R + 1).Select
            Selection.Insert Shift:=xlDown
        End If
    Next cel
    Application.ScreenUpdating = True
End Sub


Sub efface()
 Dim plage As Range, cel As Range

    Application.ScreenUpdating = False
    valcherch = ""
    With Workbooks("Récap perso.xls").Worksheets("feuil1")
        'derlig = .Range("A" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A6:A13000")
        Range("B5").Delete
        End With
  
    For Each cel In plage
    
        If cel <> valcherch Then
            cel.EntireRow.Delete
            
           ' Workbooks("Récap perso.xls").Worksheets("feuil1").Range("A9").Delete
          '  Selection.Insert Shift:=xlDown
        End If
    Next cel
    Application.ScreenUpdating = True

End Sub

Signaler Commenter la réponse de ucfoutu

ucfoutu

Messages postés: 18039
Date d'inscription: lundi 7 décembre 2009
Statut: Modérateur
Dernière intervention: 11 avril 2018

207 Modifié par ucfoutu le 22/03/2014 à 18:21

0

Merci

Bonjour,
Le plus simple, lorsque l'on veut effacer sans risques et d'un seul coup, est de constituer la plage à effacer , puis d'appliquer entirerow.delete à cette plage.
Tu as pour ce faire la méthode Application.Union (à lire dans ton aide VBA)
Reviens si encore en difficulté après cette lecture.

EDIT : je demande par contre ce que tu cherches à faire exactement par :

Range("B5").Delete

qui va décaler vers la gauche toutes les cellules de la ligne 5 à partir de la colonne C. Est-be bien ce que tu cherches à faire ?

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend

Signaler Commenter la réponse de Trophinou

Trophinou

Messages postés: 23
Date d'inscription: vendredi 13 juillet 2012
Statut: Membre
Dernière intervention: 26 mars 2014

22 mars 2014 à 18:58

0

Merci

Merci pour les infos

Par

Range("B5").delete

je voulais juste effacer la valeur inscrite dans cette cellule.

Pour tout le reste j'ai biaisé le truc en élargissant de façon démesurée la plage à déléter.

j'ai pris A5 jusque AA1000 ce qui est largement suffisant.
De plus je n'y ai pas mis de condition .

Signaler Commenter la réponse de ucfoutu

ucfoutu

Messages postés: 18039
Date d'inscription: lundi 7 décembre 2009
Statut: Modérateur
Dernière intervention: 11 avril 2018

207 - 22 mars 2014 à 19:33

Pour effacer, c'est ClearContents.
Delete décale en plus d'effacer.

Signaler Commenter la réponse de ucfoutu

ucfoutu

Messages postés: 18039
Date d'inscription: lundi 7 décembre 2009
Statut: Modérateur
Dernière intervention: 11 avril 2018

207 - 22 mars 2014 à 19:38

Pour le reste: à main levée :

dim cel as range, asuppr as range
for each cel in plage
  If cel.value <>   valcherch Then
    if asuppr is nothing then set asuppr = cel
  else
   set asuppr = application.union(asuppr, cel)
  end if
next
asuppr.entirerow.delete

devrait faire ton affaire

Signaler Commenter la réponse de Trophinou

Trophinou

Messages postés: 23
Date d'inscription: vendredi 13 juillet 2012
Statut: Membre
Dernière intervention: 26 mars 2014

- 23 mars 2014 à 00:41

Voila ce que je cherchais.

je m'entêtais à vouloir supprimer alors qu'effacer était tout aussi bien.

Un grand merci.

Votre réponse

Répondre au sujet

Posez votre question

Pour effacer, c'est ClearContents.
Delete décale en plus d'effacer.
Pour le reste: à main levée :
dim cel as range, asuppr as range
for each cel in plage
If cel.value <> valcherch Then
if asuppr is nothing then set asuppr = cel
else
set asuppr = application.union(asuppr, cel)
end if
next
asuppr.entirerow.delete
devrait faire ton affaire
Voila ce que je cherchais.

je m'entêtais à vouloir supprimer alors qu'effacer était tout aussi bien.

Un grand merci.

jordane45 · Accepted Answer · 2014-03-21T11:39:01+0100

Bonjour,

Déjà..penses que sur ce forum il est demandé d'ouvrir une discussion par difficulté/sujet technique spécifique identifié.
Là.. tu nous postes le contenu d'un projet dans sa globalité en nous indiquant les points qu'il te reste à traiter sans nous expliquer réellement quels sont les difficultés rencontrées...

Maintenant que ça a été dit... commençons par regarder quelques points de ta (tes) question(s)

J'aimerai pouvoir copier toutes les lignes ou la quantité sera égale à 1 de tous les fichiers sur un seul et même 6 éme fichier. (fichier récapitulatif)

Il te faut donc parcourir ces 5 fichiers, dans chacun parcourir les lignes pour trouver celles dont la quantité est égale à 1 et les insérer au fur et à mesure dans le 6° classeur.
( il faudra donc deux boucles.. un IF )

Est-il possible d'associer une autre macro (sur un autre bouton) pour effacer les lignes copiées afin de recommencer les commandes ?

Oui. Tu peux créer autant de macros que tu le souhaites... et les affecter à autant de bouton que tu le veux.
Pour gérer la suppression des lignes nouvellement ajouté, il faudrait (je pense que ce sera le plus simple) créer dans ton classeur de synthèse, un onglet (masqué) dans lequel tu pourras stocker le N° de ligne de départ de ta nouvelle insertion.
Ainsi, dans ta macro de suppression, tu sauras à quelle ligne commencer la suppr.

je sais pas faire les copies à la suite...

Pour ajouter des lignes à la suite.. il faut pouvoir déterminer quelle est le numéro de la dernière ligne de ton classeur (pour pouvoir ajouter à la suite).
Les (nombreux) codes qui permettent de faire ça pullulent sur le net. Tu n'auras aucun mal à trouver.
par exemple

Derniere_Ligne = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row

Si je partage ce fichiers avec mes collègues (nous sommes 17) sur leur ordi pourront-ils si chemin il doit y avoir, retrouver les bonnes adresses de fichiers ?
Ou pour faciliter la chose, dois-je leur dire d'enregistrer le tout à un endroit bien précis?

Tu peux soit imposer le répertoire dans lequel ils devront mettre leurs fichiers pour que ton code fonctionne, soit leur proposer de sélectionner le répertoire qu'ils souhaitent utiliser.

Par exemple avec ce code: "Selecteur" de répertoire :

Dim folderDialog As fileDialog 
Set folderDialog = Application.FileDialog(msoFileDialogeFolderPicker)
folderDialog.AllowMultiSelect = False
folderDialog.Show

strDir = folderDialog.SelectedItems(1)

D'autre part l'échéance étant proche, j'ai hélas pas trop le temps de chercher par moi même.

Quoi qu'il en soit... sur ce forum, nous ne ferons pas tout le travail à ta place.
J'espère que mes quelques pistes pourront t'aider à avancer.
Et n'oublie pas.. si tu reviens poser une question... c'est UNE question et non pas un projet entier par discussion.
Par exemple, tu aurais pu ( du ) ouvrir une discussion sur : Comment trouver la dernière ligne du classeur.... Une discussion sur : Comment sélectionner le répertoire où se trouve les fichiers à traiter... etc...