Création macro VBA - Problème tordu

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Création macro VBA - Problème tordu

greystick

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 )

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é )

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

Publicité

seniorpapou

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

kiki29

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

greystick

Bon bah nickel
Merci pour tout ça marche !

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Création macro VBA - Problème tordu

Sujets relatifs
Problème cookie	Problème pour compiler un projet sous Linux
Problème d'upload d'images	problème de récupération de données
Problème de link étrange	Creation de tableau
Problème SQL	Problème récupération informations base de données
Problème codes postaux avec l'API Google Maps	Problème avec script en php et commande asterisk
Plus de sujets relatifs à : Création macro VBA - Problème tordu

Page générée en 0.040 secondes