refonte d'une base de donnée créer une ligne pour chaque

[kastor]

Bonjour,

Je cherche une solution pour refondre une base de donnée.

J'ai joins le tableau, ça sera beaucoup plus simple.

j'ai donc une 1ère base de données que je crée (grâce à la précieuse aide de membres du forum), et je voudrais créer un ligne pour chaque valeur différente de 0 dans les colonnes de "T" à "AG" (en sachant que j'ajoute une colonne par mois qui passe) (Je sais qu'on est en 2013... )
Tout ça pour avoir une ligne pour chaque valeur par code et par mois en conservant les données de la ligne avant la colonne "T".

J'espère que je suis assez clair.

Merci d'avance.

 

[kastor]

Re : refonte d'une base de donnée créer une ligne pour chaque

Aux vue de la complexité et le la longueur de la macro, je vais la décomposer. (je mettrai à jour ce post au fur et à mesure)

1 comment compter le nombre de colonne entre la colonne "T" et "AG" qui ont pour la ligne 2 une valeur supérieure à 0 ?

 

[Robert]

Re : refonte d'une base de donnée créer une ligne pour chaque

Bonjour Kastor, bonjour le forum,

En pièce jointe ton fichier avec la macro ci-dessous :

Sub Macro1()
Dim os As Object 'déclare la variable os (Onglet Source)
Dim od As Object 'déclare la variable os (Onglet Destination)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim li As Range 'déclare la variable li (LIgne)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

Set os = Sheets("Feuil1") 'définit l'onglet os
Set od = Sheets("Feuil2") 'définit l'onglet od
od.Range("A1").CurrentRegion.Clear 'efface les éventuelles anciennes données (ligne peut-être à supprimer ?)
dl = os.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A) de l'onglet source
Set pl = os.Range("T2:AG" & dl) 'définit la plage pl
For Each li In pl.Rows 'boucle 1 : sur toutes les lignes de la plage pl
    For Each cel In li.Cells 'boucle 2 : sur toutes les cellules de la ligne li
        If cel.Value <> 0 Then 'condition : si la valeur de la cellule est différente de 0
            'définit la cellule de destination dest
            Set dest = IIf(od.Range("A1") = "", od.Range("A1"), od.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
            os.Cells(1, cel.Column).Copy dest 'copie la date en ligne 1
            os.Cells(cel.Row, 1).Resize(1, 19).Copy dest.Offset(0, 1) 'copie les données des colonnes A à S
            cel.Copy dest.Offset(0, 20) 'copie la valeur de la cellule cel
        End If 'fin de la condition
    Next cel 'prochaine cellule de la boucle 2
Next li 'prochaine ligne de la boucle 1
End Sub

Le fichier :

 

[kastor]

Re : refonte d'une base de donnée créer une ligne pour chaque

Mon sauveur !!!!!


MERCI

Je vais essayer de comprendre tout ça, mais c'est exactement ce qu'il me faut...