1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. VBA Office (Excel, Word ...)
Sujet Précédent Sujet Suivant

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
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
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

6 réponses

Réponse 1 / 6
jordane45
Messages postés
35778
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
4 juillet 2022
 358
21 mars 2014 à 11:39
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...
1
Réponse 2 / 6
jordane45
Messages postés
35778
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
4 juillet 2022
 358
21 mars 2014 à 11:00
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
0
Réponse 3 / 6
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
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
0
Réponse 4 / 6
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
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 235
Modifié par ucfoutu le 22/03/2014 à 18:21
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
0
Réponse 6 / 6
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
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 .
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 235
22 mars 2014 à 19:33
Pour effacer, c'est ClearContents.
Delete décale en plus d'effacer.
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 235
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
0
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.
0