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.
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.
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).
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 ?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.
Ou pour faciliter la chose, dois-je leur dire d'enregistrer le tout à un endroit bien précis?
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.
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
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionRange("B5").Deletequi 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 ?
Range("B5").deleteje voulais juste effacer la valeur inscrite dans cette cellule.
dim cel as range, asuppr as rangedevrait faire ton affaire
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