Fonction vba

Résolu
katiaboutamdja Messages postés 14 Date d'inscription   Statut Membre Dernière intervention   -  
 doudou -
Bonjour,

Je suis debutante en vba et je dois rendre un fichier pour mon stage pour lundi, ca fait 3 semaines que jsuis dessus j'arrive pas à le faire:

j'ai 729 lignes sur ma base de données, qui représente (729-19**)=720 clients pour 27 types de risques clients
sur cette base de données en colonne figurent des notes mensuelles de 01/2002 à 02/2008

le but c'est de créer automatiquement 27 feuilles excel(pour chaque risque) dans lesquels ne figurent que les informations du risque concernés sans supprimer les lignes des autres clients qui n'appartiennent pas au risque de la feuille en question, mais en supprimant seulement les informations contenu dans ces lignes donc en utilisant un clearcontents et pas delete, faut absolument que je garde le format initial 729 lignes au total.

**sachant que le clearcontents faut le commencer à la ligne 29 à chaque fois parceque avant figurent d'autres infos: ligne1 année ligne 2 mois jusqu'à la ligne 29 donc 1er client ligne 30

2 réponses

  1. cousinhub29 Messages postés 1112 Date d'inscription   Statut Membre Dernière intervention   383
     
    Bonjour,

    Afin de répondre au mieux, je pense qu'un fichier exemple, exempt de toutes données confidentielles, mais avec la structure exacte du fichier, est nécessaire...

    Il suffit de remplacer les noms des sociétés, par exemple...(ainsi que les chiffres...)

    Pour joindre le fichier, tu peux utiliser :

    http://www.cijoint.fr/</code>
    

    @ te relire
    0
  2. doudou
     
    Sub dispatch()
    Dim Cel As Range
    Dim DerLig As Long
    Dim Services As Object
    Dim Sh As Worksheet
    Dim It
    t = Timer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each Sh In Sheets 'pour chaque feuille
    If Sh.Name <> "data" Then Sh.Delete
    Next Sh 'à la suivant
    Application.DisplayAlerts = True
    Set Services = CreateObject("Scripting.Dictionary")
    With Sheets("data")
    DerLig = .[H65000].End(xlUp).Row
    For Each Cel In .Range("H20:H" & DerLig)
    If Cel <> "" Then Services(Cel.Value) = Cel.Value

    Next Cel
    For Each It In Services.Items
    Sheets("data").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = It
    Range("H19").AutoFilter Field:=8, Criteria1:="<>" & It
    Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
    Rows.Count - 1).SpecialCells(xlCellTypeVisible).ClearContents
    Range("H19").AutoFilter
    ActiveSheet.Shapes("Rectangle 1").Delete
    Next It
    .Select
    End With
    MsgBox Timer - t
    End Sub

    Voila la solution si quelqu'un en a besoin
    à savoir on utilise clearcontents pour effacer le contenu des cellules
    j'éspère qu'un maximum de personnes en profitera
    0