Mise en forme des données d'une feuille excel [Résolu/Fermé]

Signaler
-
 Grigri -
Bonjour étant débutant avec excel, je suis à la recherche d'une solution pour mon problème.
voici le modèle du fichier sur lequel je travail : http://cjoint.com/14mi/DEBqWHLRplK.htm

Je souhaiterais donc obtenir les données de la feuille1 réorganiser sur la feuille 2 comme le modèle fournis. pour information, chaque enregistrement fait 3 ou 4 lignes sur la feuille1 selon si il y a ou pas une "ad2 fact"

Merci par avance,
Cordialement

1 réponse

Messages postés
13004
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
25 avril 2021
2 179
Bonjour

Une solution par macro

Alt F11 pour ouvrir l'éditeur - copier -coller la macro

Pour lancer la macro Onglet Developpeur Macros transfert Executer

Sub transfert()
lg = 1
x = 0
Dim DernLigne As Long
DernLigne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
For n = 1 To DernLigne
If IsDate(Sheets("Feuil1").Range("A" & n).Value) Then
With Sheets("Feuil2")
.Range("A" & lg) = Sheets("Feuil1").Range("A" & n)
.Range("B" & lg) = Sheets("Feuil1").Range("B" & n)
.Range("C" & lg) = Sheets("Feuil1").Range("C" & n)
.Range("D" & lg) = Sheets("Feuil1").Range("D" & n)
.Range("E" & lg) = Sheets("Feuil1").Range("A" & n + 1)
End With
If Sheets("Feuil1").Range("B" & n + 2) = "" Then x = 1: Sheets("Feuil2").Range("F" & lg) = Sheets("Feuil1").Range("A" & n + 2)
With Sheets("Feuil2")
.Range("G" & lg) = Sheets("Feuil1").Range("A" & n + 2 + x)
.Range("H" & lg) = Sheets("Feuil1").Range("B" & n + 2 + x)
.Range("I" & lg) = Sheets("Feuil1").Range("C" & n + 2 + x)
.Range("J" & lg) = Sheets("Feuil1").Range("D" & n + 2 + x)
.Range("K" & lg) = Sheets("Feuil1").Range("E" & n + 2 + x)
.Range("L" & lg) = Sheets("Feuil1").Range("F" & n + 2 + x)
.Range("M" & lg) = Sheets("Feuil1").Range("G" & n + 2 + x)
.Range("N" & lg) = Sheets("Feuil1").Range("H" & n + 2 + x)
.Range("O" & lg) = Sheets("Feuil1").Range("I" & n + 2 + x)
.Range("P" & lg) = Sheets("Feuil1").Range("J" & n + 2 + x)
End With
lg = lg + 1
End If
Next n
End Sub


Cdlmnt

Messages postés
13004
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
25 avril 2021
2 179
Je viens de m'apercevoir dans la macro précédente, voici la bonne macro :
Sub transfert()
lg = 1

Dim DernLigne As Long
DernLigne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
For n = 1 To DernLigne
x = 0
If IsDate(Sheets("Feuil1").Range("A" & n).Value) Then
With Sheets("Feuil2")
.Range("A" & lg) = Sheets("Feuil1").Range("A" & n)
.Range("B" & lg) = Sheets("Feuil1").Range("B" & n)
.Range("C" & lg) = Sheets("Feuil1").Range("C" & n)
.Range("D" & lg) = Sheets("Feuil1").Range("D" & n)
.Range("E" & lg) = Sheets("Feuil1").Range("A" & n + 1)
End With
If Sheets("Feuil1").Range("B" & n + 2) = "" Then x = 1: Sheets("Feuil2").Range("F" & lg) = Sheets("Feuil1").Range("A" & n + 2)
With Sheets("Feuil2")
.Range("G" & lg) = Sheets("Feuil1").Range("A" & n + 2 + x)
.Range("H" & lg) = Sheets("Feuil1").Range("B" & n + 2 + x)
.Range("I" & lg) = Sheets("Feuil1").Range("C" & n + 2 + x)
.Range("J" & lg) = Sheets("Feuil1").Range("D" & n + 2 + x)
.Range("K" & lg) = Sheets("Feuil1").Range("E" & n + 2 + x)
.Range("L" & lg) = Sheets("Feuil1").Range("F" & n + 2 + x)
.Range("M" & lg) = Sheets("Feuil1").Range("G" & n + 2 + x)
.Range("N" & lg) = Sheets("Feuil1").Range("H" & n + 2 + x)
.Range("O" & lg) = Sheets("Feuil1").Range("I" & n + 2 + x)
.Range("P" & lg) = Sheets("Feuil1").Range("J" & n + 2 + x)
End With

lg = lg + 1
End If
Next n
End Sub

Cdlmnt