Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1469 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Création macro VBA - Problème tordu

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Création macro VBA - Problème tordu

n°1872259
greystick
Posté le 11-04-2009 à 16:33:28  profilanswer
 

Bonjour,
 
Je cherche en vain à faire une macro répondant à cet objectif :
Je veux créer autant de feuilles qu'il y a de valeur différente dans une même colonne et que pour chacune de ces valeurs de la colonne la ligne correspondante soit copiée/collée dans la feuille correspondante. (C'est clair  :o )
 
Par exemple :
 
J'ai une feuille appelée "BDD" Excel avec 6 valeurs en colonne A :
 
Toto
Papa
Maman
Toto
Toto
Maman
 
Avant tout, je les "sort" par la colonne A (ça c'est dans mes cordes)
 
1) je souhaite que la macro fasse une feuille pour chaque valeurs différentes de la colonne A
En gros j'ai ma feuille "BDD", ma feuille "Toto", ma feuille "Papa" et ma feuille "Maman"
(1bis La macro nomme les feuilles avec le nom de la valeur)
 
J'ai tenté un :
for each value in columns("A" )
Add.sheets
 
Mais sans succès, ça me créé une feuille et une seule
 
2) La macro copie/colle chaque ligne de la BDD dans le bon onglet
Dans la feuille Toto, on a donc 3 lignes (Car y a 3 toto dans la colonne A de la feuille BDD)
Dans la feuille Papa, on a donc 2 lignes (Car y a 2 Papa dans la colonne A de la feuille BDD)
Dans la feuille Maman, on a donc 1 ligne (Car y a 1 maman dans la colonne A de la feuille BDD)
 
J'ai tenté une boucle en comparant la value de la colonne mais sans succès
 
3) La BDD ne doit pas bouger (Sinon je suis viré  :ange: )
 
Merci pour votre aide
 

Spoiler :

Désolé d'être nul  :( en VBA


Message édité par greystick le 11-04-2009 à 16:34:33

---------------
Bière qui roule, bière qui mousse
mood
Publicité
Posté le 11-04-2009 à 16:33:28  profilanswer
 

n°1872270
seniorpapo​u
Posté le 11-04-2009 à 18:43:09  profilanswer
 

Bonsoir,
vite fait pour créer les feuilles
après, tu cherches un peu pour copier les lignes .
 
Sub Macro1()
'
' Macro1 Macro
'
 
'
    For lig = 1 To 65000
     
   If Sheets("feuil1" ).Cells(lig, 1) = "" Then Exit Sub
    lenom = Sheets("feuil1" ).Cells(lig, 1)
    yapas = True
    For Each sh In ThisWorkbook.Sheets
    If sh.Name = lenom Then
    yapas = False
    Exit For
    End If
    Next
    If yapas Then
    Sheets("Feuil2" ).Select  'ou une autre
    Sheets.Add
   ActiveSheet.Name = lenom
 
   End If
    '..copier la ligne après la dernière ligne
   Next
End Sub
 
Cordialement
 
En espèrant que cela fonctionne

n°1872271
kiki29
Posté le 11-04-2009 à 18:52:43  profilanswer
 

Salut,  


Option Explicit
 
Sub GenererFeuilles()
Dim i As Long, sNomFeuille As String
Dim LastRow As Long, LastRowSh As Long
 
    Application.ScreenUpdating = False
 
    LastRow = ShBDD.Range("A" & Rows.Count).End(xlUp).Row
     
    For i = 1 To LastRow
        sNomFeuille = ShBDD.Cells(i, 1)
        If ExistenceFeuille(sNomFeuille) = False Then
            Sheets.Add
            ActiveSheet.Name = sNomFeuille
            ShBDD.Cells(i, 2).Copy Destination:=ActiveSheet.Cells(1, 1)
        Else
            LastRowSh = Sheets(sNomFeuille).Range("A" & Rows.Count).End(xlUp).Row
            ShBDD.Cells(i, 2).Copy Destination:=Sheets(sNomFeuille).Cells(LastRowSh + 1, 1)
        End If
    Next i
     
    ShBDD.Move Before:=Sheets(1)
    Application.ScreenUpdating = True
End Sub
 
Private Function ExistenceFeuille(ByVal sNomFeuille As String) As Boolean
    On Error Resume Next
    ExistenceFeuille = Sheets(sNomFeuille).Name <> ""
End Function


 
On pourra incorporer une routine de vérification de la validité du nom des feuilles


Private Function NomFeuilleValide(ByVal sNom As String) As String
Const CaracInterdits As String = ":/\?*[]"
Dim i As Integer, Car As String * 1
 
    Select Case Len(sNom)
        Case 0: Exit Function
        Case Is > 31: sNom = Left(sNom, 31)
    End Select
 
    For i = 1 To Len(CaracInterdits)
        Car = Mid(CaracInterdits, i, 1)
        sNom = Replace(sNom, Car, "" )
    Next i
 
    NomFeuilleValide = Trim(sNom)
End Function


et pourquoi pas une routine de tri très sommaire


Private Sub TriFeuilles()
Dim Cpt As Long, Cpt2 As Long
Dim NbSh As Long
 
    NbSh = Sheets.Count
 
    For Cpt = 1 To NbSh
        For Cpt2 = Cpt To NbSh
            If UCase(Sheets(Cpt2).Name) < UCase(Sheets(Cpt).Name) Then
                Sheets(Cpt2).Move Before:=Sheets(Cpt)
            End If
        Next Cpt2
    Next Cpt
     
    ShBDD.Move Before:=Sheets(1)
End Sub


Message édité par kiki29 le 12-04-2009 à 09:18:36
n°1872495
greystick
Posté le 13-04-2009 à 18:27:13  profilanswer
 

Bon bah nickel :)
Merci pour tout ça marche !


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Création macro VBA - Problème tordu

 

Sujets relatifs
Problème cookieProblème pour compiler un projet sous Linux
Problème d'upload d'imagesproblème de récupération de données
Problème de link étrangeCreation de tableau
Problème SQLProblème récupération informations base de données
Problème codes postaux avec l'API Google MapsProblème avec script en php et commande asterisk
Plus de sujets relatifs à : Création macro VBA - Problème tordu


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR