Est-ce possible retranscription de donnees via VBA ou fonctions

[chakib]

Bonjour a tous,

Je sollicite votre aide pour un problème qui me parait tellement compliqué a faire , j'ai besoin de retranscrire des donnes d'un formulaire dans un autre onglet mais sous forme de lignes.
je vous mets un fichier ou j'explique tout.
Je vous remercie énormément par avance de votre éventuelle aide.

 

[fanfan38]

Re : Est-ce possible retranscription de donnees via VBA ou fonctions

Bonjour
Je ne pense pas que ca peut être fait à l'aide de fonction mais ci joint ma solution en vba (macro)
A+ François

 

[chakib]

Re : Est-ce possible retranscription de donnees via VBA ou fonctions

Bonjour Francois,

Mille merci pour ton aide la macro repond exactement a mon besoin , j'ai rajouter une colonne peux-tu jeter un oeil pour l'inclure a la macro.
Merci infiniment de ton aide.

 

[fanfan38]

Re : Est-ce possible retranscription de donnees via VBA ou fonctions

Bonjour,
Tu ajoutes les lignes ci dessous dans la boucle for next après Cells(i, 6).Value = "" et avant le next...

Sheets("Data3").Cells(derlig, i + 51) = Cells(i, 12).Value
Cells(i, 12).Value = ""

A+ François

 

[chakib]

Re : Est-ce possible retranscription de donnees via VBA ou fonctions

Merci beaucoup Francois , juste une derniere question sur ma nouvelle colonne en question c'est des hyperlien que je rajoute , et lors de la copie il me copie que le texte , je me demandais s'il est possible qu'il me copie vraiment avec le chemin au lieu de me copier juste en texte sans chemin.
Merci encore francois pour votre aide

 

[fanfan38]

Re : Est-ce possible retranscription de donnees via VBA ou fonctions

Voilà la nouvelle macro... (pour des liens hypertext on doit passer par un copier coller)
Sub Bouton1_Clic()
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Set FL1 = ThisWorkbook.ActiveSheet
Set FL2 = ThisWorkbook.Sheets("Data3")
derlig = FL2.Range("A65536").End(xlUp).Row + 1
FL2.Cells(derlig, 1) = Range("b3").Value
Range("b3").ClearContents
FL2.Cells(derlig, 2) = Range("b4").Value
Range("b4").ClearContents
FL2.Cells(derlig, 3) = Range("b5").Value
Range("b5").ClearContents
FL2.Cells(derlig, 4) = Range("d3").Value
Range("d3").ClearContents
FL2.Cells(derlig, 5) = Range("d4").Value
Range("d4").ClearContents
FL2.Cells(derlig, 6) = Range("d5").Value
Range("d5").ClearContents
FL2.Cells(derlig, 7) = Range("f3").Value
Range("f3").ClearContents
FL2.Cells(derlig, 8) = Range("f4").Value
Range("f4").ClearContents
FL2.Cells(derlig, 9) = Range("h3").Value
Range("h3").Value = ""
FL2.Cells(derlig, 10) = Range("h4").Value
Range("h4").Value = ""
FL2.Cells(derlig, 11) = Range("k3").Value
Range("k3").Value = ""
FL2.Cells(derlig, 12) = Range("k4").Value
Range("k4").Value = ""
For i = 8 To 30
FL2.Cells(derlig, i + 5) = Cells(i, 5).Value
Cells(i, 5).Value = ""
FL2.Cells(derlig, i + 28) = Cells(i, 6).Value
Cells(i, 6).Value = ""
FL1.Cells(i, 12).Copy FL2.Cells(derlig, i + 51)
Cells(i, 12).ClearContents
Next
End Sub

A+ François