Copier Pls Lignes de pls fichiers vers 1 seul sous condition. [Résolu]
Trophinou23
Messages postés vendredi 13 juillet 2012Date d'inscription
26 mars 2014
Dernière intervention
-
21 mars 2014 à 10:34 - Dernière réponse : Trophinou23
Messages postés vendredi 13 juillet 2012Date d'inscription
26 mars 2014
Dernière intervention
- 23 mars 2014 à 00:41
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.
jordane4521389
Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut
12 juin 2018
Dernière intervention -21 mars 2014 à 11:39
1
Merci
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
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...
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
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
ucfoutu18039
Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut
11 avril 2018
Dernière intervention -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
a aidé 130 internautes ce mois-ci