MACRO SUITE EXTRACTION LISTE DEROULANTE

Fermé

REGIS6460 Messages postés 6 Date d'inscription lundi 19 mars 2018 Statut Membre Dernière intervention 24 mars 2018 - 23 mars 2018 à 18:11
REGIS6460 Messages postés 6 Date d'inscription lundi 19 mars 2018 Statut Membre Dernière intervention 24 mars 2018 - 24 mars 2018 à 12:49

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

A voir également:

MACRO SUITE EXTRACTION LISTE DEROULANTE
Liste déroulante excel - Guide
Liste déroulante en cascade - Guide
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur

4 réponses

Réponse 1 / 4

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 23 mars 2018 à 18:54

Bonjour,

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à

Réponse 2 / 4

REGIS6460 Messages postés 6 Date d'inscription lundi 19 mars 2018 Statut Membre Dernière intervention 24 mars 2018
23 mars 2018 à 19:25

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

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 23 mars 2018 à 20:52

C'est normal, la copie se fait sur les même lignes

 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

@+

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
24 mars 2018 à 06:46

Après une nuit de repos, voilà beaucoup plus simple:

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

Réponse 3 / 4

REGIS6460 Messages postés 6 Date d'inscription lundi 19 mars 2018 Statut Membre Dernière intervention 24 mars 2018
24 mars 2018 à 08:51

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

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
24 mars 2018 à 09:06

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:

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

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
24 mars 2018 à 12:36

Voici une autre manière en créant une feuille avec le nom comme ceci:

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

Réponse 4 / 4

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié le 24 mars 2018 à 12:33

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/

REGIS6460 Messages postés 6 Date d'inscription lundi 19 mars 2018 Statut Membre Dernière intervention 24 mars 2018
24 mars 2018 à 12:49

je vais tester, par contre effectivement la nombre de nom peut evoluer et changer

Discussions similaires

Suppression listes déroulantes

Accéder à la liste de numéros de téléphone en 07

Annuaire inversé liste rouge

Supprimer liste déroulante Excel

Discussions similaires

Newsletters