Macro exportation feuille Résolu/Fermé

Question

Bonjour,

La macro qui se trouve ci-dessous permet d'exporter des lignes d'une feuille à l'autre selon un critère prédéfini.
Voici cette macro :

Sub copie()'Macro Dan pourDim dlg As Integer, i As Integer, lig As Integerdlg = Sheets("Feuil1").Range("A65536").End(xlUp).Rowlig = Sheets("Feuil2").Range("A65536").End(xlUp).RowIf lig <> 1 Then Sheets("Feuil2").Range("A4:G" & lig).ClearContentslig = 2For i = 2 To dlgIf Sheets("Feuil1").Range("A" & i) = "92.05.06." Then Sheets("Feuil1").Range("A" & i & ":G" & i).Copy Sheets("Feuil2").Range("A" & lig)lig = lig + 1NextEnd Sub

Cette macro ne me permet que de mettre une variable à la fois et de faire qu'une exportation de la feuille 1 à la feuille 2.
Je voudrais pouvoir automatiser/optimiser cela en donnant la possibilité à l'utilisateur, sur la feuille 1, d'entrer une valeur et un endroit d'export. Par exemple, l'utilisateur entre dans une case le Numero 00.00. et dans une autre Feuil4 et appuie sur un bouton exécuter.
Y-a-t-il un moyen de faire cela?

Merci de votre aide.

seb

via55 · Answer

Bonsoir

Plutôt que dans les cellules de la feuille 1 il serait plus judicieux de demander le numero à transférer et la feuille de destination par des inputbox

Ta macro peut être adaptée de cette manière

Sub copie()
Dim dlg As Integer, i As Integer, lig As Integer

numero = InputBox("Numero à transférer")
feuille = InputBox("Nom de la feuille de destination")
ok = 0
For n = 1 To Sheets.Count
If Sheets(n).Name = feuille Then ok = 1
Next
If ok = 0 Then MsgBox ("La feuille " & feuille & " n'existe pas"): Exit Sub

dlg = Sheets("Feuil1").Range("A65536").End(xlUp).Row
lig = Sheets(feuille).Range("A65536").End(xlUp).Row

If lig <> 1 Then Sheets(feuille).Range("A4:G" & lig).ClearContents
lig = 2
For i = 2 To dlg
If Sheets("Feuil1").Range("A" & i) = numero Then Sheets("Feuil1").Range("A" & i & ":G" & i).Copy Sheets(feuille).Range("A" & lig)
lig = lig + 1
Next

End Sub

Ensuite tu crées un bouton sur la feuille 1 et tu fais Visualiser le code pour y mettre ceci pour l'execution de la macro :
Private Sub CommandButton1_Click()
copie
End Sub

Cdlmnt

santille · Answer

OK, merci bien, ça fonctionne.

seb

santille · Answer

Cela fonctionne mais 2 problèmes sont apparus :

1/ il faudrait que je puisse répéter l'opération plusieurs fois sur la même feuille. Par exemple inscrire plusieurs numéros dans la même feuille. Ici, il n'additionne pas les lignes, il efface et met le nouveau numéro à la suite...

2/ j'ai nommé des feuilles de 1 à 11. Si je fais directement l'opération d'insertion de numéro sur la Feuille 11 par exemple, cela ne fonctionne pas.

Merci de votre aide.

Sébastien

via55 · Answer

1) c'est normal la macro que tu avais fourni efface les lignes avant de copier
si tu ne veux plus d'effacement mais des recopies à la suite il faut :
a) supprimer la ligne  If lig <> 1 Then Sheets(feuille).Range("A4:G" & lig).ClearContents
b) remplacer la ligne suivante : lig = 2 par lig=lig+1

2) je ne comprends pas la question : que veux tu dire par opération d'insertion de numéro su la feuille 11 ?
La macro est conçue pour transferer de la feuille 1 à n'importe quelle autre feuille 
si tu veux mettre des boutons sur d'autres feuilles et  transferer à partir de ces feuilles il faut remplacer les Sheets("Feuil1") dans la macro par ActiveSheet

santille · Answer

OK pour le point 1.
Mais pour le point 2, je confirme : si j'entre un numéro et que je sélectionne la feuille 11, il n'y pas d'export.
Les lignes comportant ce numéro n'apparaissent pas dans la feuille 11.

merci.

seb

via55 · Answer

Difficile à dire ce qui cloche sans voir ton fichier !
Es tu sur que le nom que tu rentres dans l'inputbox est bien le même que celui de la feuille 11 ?
As tu essayé avec d'autres feuille 12, 13 etc?

santille · Answer

Oui, cela fait avec les autres feuilles.
Y-a-t-il un moyen pour que je puisse te transmettre le fichier étant donné qu'il n'y a pas d'option de pièce jointe?
Eventuellement ton mail?

Merci encore.

seb

via55 · Answer

Bonsoir

Tu postes ton fichier allégé et anonymé sur transfernow.net ou cjoint.com et tu indiques ensuite ici le lien fourni

Cdlmnt

santille · Answer

OK.

Voici le lien :

transfernow.net/fr/3s4q90869r86

Merci.

seb

via55 · Answer

Voilà le fichier

Légèrement modifié la macro pour que la recherche de la dernière ligne vide fonctionne sur toutes versions
J'ai également shunté la ligne de macro qui effaçait les lignes précédentes en mettant un ' devant qu'il suffira de supprimer si tu veux de nouveau rendre cette ligne active

https://www.transfernow.net/files/?utm_source=56jwf32lyfg0&utm_medium=&utm_content=fr
Le transfert se fait bien sur toutes les feuilles y compris sur la Feuil11 que j'ai crée

Cdlmnt

santille · Answer

Super.

Je crois que j'ai tout ce qu'il me fallait.

Merci bien de ton aide et bonne journée.

seb

Macro exportation feuille

11 réponses

Discussions similaires

Newsletters