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

Trophinou 23 Messages postés vendredi 13 juillet 2012Date d'inscription 26 mars 2014 Dernière intervention - 21 mars 2014 à 10:34 - Dernière réponse : Trophinou 23 Messages postés vendredi 13 juillet 2012Date d'inscription 26 mars 2014 Dernière intervention
- 23 mars 2014 à 00:41
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 

Votre réponse

9 réponses

Meilleure réponse
jordane45 22103 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 18 août 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
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...

Merci jordane45 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de jordane45
jordane45 22103 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 18 août 2018 Dernière intervention - 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
Commenter la réponse de jordane45
Trophinou 23 Messages postés vendredi 13 juillet 2012Date d'inscription 26 mars 2014 Dernière intervention - 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
Commenter la réponse de Trophinou
Trophinou 23 Messages postés vendredi 13 juillet 2012Date d'inscription 26 mars 2014 Dernière intervention - 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
Commenter la réponse de Trophinou
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 11 avril 2018 Dernière intervention - 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
Commenter la réponse de ucfoutu
Trophinou 23 Messages postés vendredi 13 juillet 2012Date d'inscription 26 mars 2014 Dernière intervention - 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 .
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 11 avril 2018 Dernière intervention - 22 mars 2014 à 19:33
Pour effacer, c'est ClearContents.
Delete décale en plus d'effacer.
ucfoutu 18039 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
devrait faire ton affaire
Trophinou 23 Messages postés vendredi 13 juillet 2012Date d'inscription 26 mars 2014 Dernière intervention - 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.
Commenter la réponse de Trophinou

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.