MACRO SUITE EXTRACTION LISTE DEROULANTE
REGIS6460
Messages postés
6
Statut
Membre
-
REGIS6460 Messages postés 6 Statut Membre -
REGIS6460 Messages postés 6 Statut Membre -
Bonjour,
Je sèche completement :un classeur avec une feuille ""FEUIL1"
Col A :CODE
Col B CLIENT
Col C Nom
J'aimerais à partir d'un filtre sur le nom, copier les lignes correspondantes vers une autre feuille (meme classeur) et renomer la feuille avec le nom
Ex choix du nom "A", recopier les lignes sur FEUIL2 et la renomer en A
Idem pour "B" vers FEUIL3, renomée en B
et ainsi de suite
Je voudrais automatiser tout ca, mais rien de fonctionne
Avez vous des idees?
Merci
Je sèche completement :un classeur avec une feuille ""FEUIL1"
Col A :CODE
Col B CLIENT
Col C Nom
J'aimerais à partir d'un filtre sur le nom, copier les lignes correspondantes vers une autre feuille (meme classeur) et renomer la feuille avec le nom
Ex choix du nom "A", recopier les lignes sur FEUIL2 et la renomer en A
Idem pour "B" vers FEUIL3, renomée en B
et ainsi de suite
Je voudrais automatiser tout ca, mais rien de fonctionne
Avez vous des idees?
Merci
A voir également:
- MACRO SUITE EXTRACTION LISTE DEROULANTE
- Liste déroulante excel - Guide
- Liste déroulante en cascade - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste code ascii - Guide
- Liste déroulante google sheet - Accueil - Guide bureautique
4 réponses
Bonjour,
En vba a adapter:
on peut le faire avec des InputBox comme ceci:
cela permet toutes les situations sans changer le code!
Voilà
En vba a adapter:
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
Set FL1 = Worksheets("Feuil1")
NoCol = 3 'lecture de la colonne C
For NoLig = 1 To Range("C" & Rows.Count).End(xlUp).Row 'dernière ligne colonne C
Var = FL1.Cells(NoLig, NoCol)
If Var = "A" Then
Sheets("Feuil2").Cells(NoLig, NoCol - 2).Value = FL1.Cells(NoLig, NoCol - 2).Value
Sheets("Feuil2").Cells(NoLig, NoCol - 1).Value = FL1.Cells(NoLig, NoCol - 1).Value
End If
Next
Set FL1 = Nothing
Sheets("Feuil2").Name = "A"
End Sub
on peut le faire avec des InputBox comme ceci:
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, var As Variant
Dim nom As String
Dim feuille As String
nom = InputBox("Saisie du nom a rechercher : ", "NOM", "A")
feuille = InputBox("Saisie du nom de la feuille receptrice : ", "NOM Feuille", "Feuil2")
Set FL1 = Worksheets("Feuil1")
NoCol = 3 'lecture de la colonne C
For NoLig = 1 To Range("C" & Rows.Count).End(xlUp).Row 'dernière ligne colonne C
var = FL1.Cells(NoLig, NoCol)
If var = nom Then
Sheets(feuille).Cells(NoLig, NoCol - 2).Value = FL1.Cells(NoLig, NoCol - 2).Value
Sheets(feuille).Cells(NoLig, NoCol - 1).Value = FL1.Cells(NoLig, NoCol - 1).Value
End If
Next
Set FL1 = Nothing
Sheets(feuille).Name = nom
End Sub
cela permet toutes les situations sans changer le code!
Voilà
Après de petites modifs, la méthode en haut me va bien, par contre il me filtre bien les nom et me les recopies sur une nouvelle feuille mais en laissant les lignes vides qui ne correspondent pas au filtre.
Ex : LIGNE 1-2 , A
LIGNE 3 reste vide car <>A
LIGNE 4 , A
LIGNE 5-6 reste vide car <>A
Que rajouter pour regrouper la selection?
Sinon reste ok pour mes besoins
Merci
Ex : LIGNE 1-2 , A
LIGNE 3 reste vide car <>A
LIGNE 4 , A
LIGNE 5-6 reste vide car <>A
Que rajouter pour regrouper la selection?
Sinon reste ok pour mes besoins
Merci
C'est normal, la copie se fait sur les même lignes
Ceux sont les mêmes numéros de lignes
Il faut donc faire une boucle pour supprimer les lignes vides!
j'ai un peu de temps, voici la boucle qui part de la dernière ligne vers le haut a adapter:
Voilà a intégrer dans l'autre boucle avant le renommage de la feuille
@+
Sheets(feuille).Cells(NoLig, NoCol - 2).Value = FL1.Cells(NoLig, NoCol - 2).Value
Sheets(feuille).Cells(NoLig, NoCol - 1).Value = FL1.Cells(NoLig, NoCol - 1).Value
Ceux sont les mêmes numéros de lignes
Il faut donc faire une boucle pour supprimer les lignes vides!
j'ai un peu de temps, voici la boucle qui part de la dernière ligne vers le haut a adapter:
Sub deleteline()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, var As Variant
Set FL1 = Worksheets("Feuil2")
NoCol = 1 'lecture de la colonne A
For NoLig = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 'boucle en commençant par le bas
var = FL1.Cells(NoLig, NoCol)
If var = "" Then
Rows(NoLig & ":" & NoLig).Delete Shift:=xlUp
End If
Next
Set FL1 = Nothing
End Sub
Voilà a intégrer dans l'autre boucle avant le renommage de la feuille
@+
Après une nuit de repos, voilà beaucoup plus simple:
@+ Le Pivert
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
Dim ligne As Integer
ligne = 1 '1ère ligne de la feuil2
Set FL1 = Worksheets("Feuil1")
NoCol = 3 'lecture de la colonne C
For NoLig = 1 To Range("C" & Rows.Count).End(xlUp).Row 'dernière ligne colonne C
Var = FL1.Cells(NoLig, NoCol)
If Var = "A" Then
Sheets("Feuil2").Cells(ligne, NoCol - 2).Value = FL1.Cells(NoLig, NoCol - 2).Value
Sheets("Feuil2").Cells(ligne, NoCol - 1).Value = FL1.Cells(NoLig, NoCol - 1).Value
ligne = ligne + 1
End If
Next
Set FL1 = Nothing
Sheets("Feuil2").Name = "A"
End Sub
@+ Le Pivert
Bonjour
Déjà pas mal avancé avec votre aide, par contre le seul souci c'est que je dois connaitre les noms, ce qui ne sera pas toujours le cas.
Ces noms etant inscrit dans la macro (ici A,B....)
Une solution pour aller cherche le premier nom de la liste de choix, faire les copie sur autre feuille (copie et mise enforme ok de ce cote), et passer au nom suivant .....
Régis
Déjà pas mal avancé avec votre aide, par contre le seul souci c'est que je dois connaitre les noms, ce qui ne sera pas toujours le cas.
Ces noms etant inscrit dans la macro (ici A,B....)
Une solution pour aller cherche le premier nom de la liste de choix, faire les copie sur autre feuille (copie et mise enforme ok de ce cote), et passer au nom suivant .....
Régis
La solution démarrer la macro au double clic sur le nom comme ceci,
Se mettre sur la feuille concernée(Feuil1 par ex) faire Alt F11 pour accèder au module de cette feuille et mettre ce code:
Voilà c'est simple
Se mettre sur la feuille concernée(Feuil1 par ex) faire Alt F11 pour accèder au module de cette feuille et mettre ce code:
Option Explicit
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
Dim nom As String
Dim feuille As String
Dim ligne As Integer
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
On Error Resume Next
If Target.Value = "" Then Exit Sub
nom = Target.Value
For_X_to_Next_Ligne
End If
End Sub
Sub For_X_to_Next_Ligne()
ligne = 1 '1ère ligne de la feuil2
feuille = InputBox("Saisie du nom de la feuille receptrice : ", "NOM Feuille", "Feuil2")
Set FL1 = Worksheets("Feuil1")
NoCol = 3 'lecture de la colonne C
For NoLig = 1 To Range("C" & Rows.Count).End(xlUp).Row 'dernière ligne colonne C
Var = FL1.Cells(NoLig, NoCol)
If Var = nom Then
Sheets(feuille).Cells(ligne, NoCol - 2).Value = FL1.Cells(NoLig, NoCol - 2).Value
Sheets(feuille).Cells(ligne, NoCol - 1).Value = FL1.Cells(NoLig, NoCol - 1).Value
ligne = ligne + 1
End If
Next
Set FL1 = Nothing
Sheets(feuille).Name = nom
End Sub
Voilà c'est simple
Voici une autre manière en créant une feuille avec le nom comme ceci:
a toi de choisir
@+ Le Pivert
Option Explicit
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
Dim nom As String
Dim feuille As Worksheet
Dim ligne As Integer
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
On Error Resume Next
If Target.Value = "" Then Exit Sub
nom = Target.Value
For_X_to_Next_Ligne
End If
End Sub
Sub For_X_to_Next_Ligne()
ligne = 1 '1ère ligne de la nouvelle feuille
Set feuille = Sheets.Add(After:=Sheets(Sheets.Count)) 'se place en dernier
feuille.Name = nom
Set FL1 = Worksheets("Feuil1")
NoCol = 3 'lecture de la colonne C
For NoLig = 1 To Range("C" & Rows.Count).End(xlUp).Row 'dernière ligne colonne C
Var = FL1.Cells(NoLig, NoCol)
If Var = nom Then
Sheets(nom).Cells(ligne, NoCol - 2).Value = FL1.Cells(NoLig, NoCol - 2).Value
Sheets(nom).Cells(ligne, NoCol - 1).Value = FL1.Cells(NoLig, NoCol - 1).Value
ligne = ligne + 1
End If
Next
Set FL1 = Nothing
End Sub
a toi de choisir
@+ Le Pivert
Bonjour,
Ci joint proposition
on ajoute la feuille au nom choisi ("A") et au copie les code et les client afférant au nom choisi. On teste au début si le nom choisi existe bien dans la colonne "nom" avec la possibilité de rectifier l'erreur.
j'ai pris un inputname comme l'a proposé Lepivert que je salue, mais il aurait été peut-être intéressant de le faire par un formulaire avec la liste des différents noms
mais tu n'as pas mentionné si ta liste pouvait évoluer ( nouveaux "A" par ex) ce qui changerait pas mal de choses !
https://mon-partage.fr/f/t5GQjt3s/
Ci joint proposition
on ajoute la feuille au nom choisi ("A") et au copie les code et les client afférant au nom choisi. On teste au début si le nom choisi existe bien dans la colonne "nom" avec la possibilité de rectifier l'erreur.
j'ai pris un inputname comme l'a proposé Lepivert que je salue, mais il aurait été peut-être intéressant de le faire par un formulaire avec la liste des différents noms
mais tu n'as pas mentionné si ta liste pouvait évoluer ( nouveaux "A" par ex) ce qui changerait pas mal de choses !
https://mon-partage.fr/f/t5GQjt3s/
