Extraction de données dans cellules différentes

[Maud44]

Bonjour,

Je suis actuellement en train de travailler sur un fichier et j'aimerai extraire des informations dans des cellules à part. Par exemple pour l'exemple du fichier joint : (élément en surbrillance jaune qui nous intéresse) : on voit que le lundi à 12h il y a un client et nous voulons que l'information LUNDI 12h apparaisse dans des cellules distinctes comme dans les cellules : P2 et Q2 .

Avez vous une idée de la méthode a appliquer?

Merci par avance,

Cordialement,

 

[JBARBE]

Re : Extraction de données dans cellules différentes

Bonsoir à tous,

En cliquant sur le bouton selection !

bonne soirée

 

[gosselien]

Re : Extraction de données dans cellules différentes

Bonjour,

avec copier/coller/transposer....

Range("J1:O5").Select ' zone à adapter !!!
Selection.Copy
Range("P1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False

P.

 

[Maud44]

Re : Extraction de données dans cellules différentes

Bonjour à Tous, Bonjour JBARBE

C'est exactement ca !

Le code est :
Sub Transfert()
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
Range("P2:S65536").ClearContents
For i = 2 To 65536
If Cells(i, 1) = "" Then Exit Sub
For j = 10 To 15
If Cells(i, j) <> "" Then
If Cells(i, 16) = "" And Cells(i, 17) = "" Then
Cells(i, 17) = Cells(i, j)
Cells(i, 16) = Cells(1, j)
ElseIf Cells(i, 18) = "" And Cells(i, 19) = "" Then
Cells(i, 19) = Cells(i, j)
Cells(i, 18) = Cells(1, j)
ElseIf Cells(i, 20) = "" And Cells(i, 21) = "" Then
Cells(i, 21) = Cells(i, j)
Cells(i, 20) = Cells(1, j)
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub


Maintenant, pour étendre la macro sur toutes la page... et donc effectuer la sélection d'information dès qu'il y a une heure de saisie comment faut il procéder? (modification de la macro)

Merci par avance!

Cordialement,

 

[Maud44]

Re : Extraction de données dans cellules différentes

Rebonjour,
Je viens de comprendre. La manipulation ne marchait pas car, je n'avait pas renseigné de données dans les premières cellules !
Pourtant j'avais vu que la macro valait pour les cellules: Range("P2:S65536") !
Merci

 

[Maud44]

Re : Extraction de données dans cellules différentes

Bonjour,

Je viens de remarquer que la macro prend en compte maximum 3 jours avec les horaires qui correspondent.
Que faut il modifier dans le code pour que s'il y a 5 horaires qui sont renseignés, les jours et horaires apparaissent:
Il faudrait que les valeurs puissent s'inscrire jusqu’à la cellule Y (je l'ai d'ailleurs modifié dans le code (en rouge)):

Sub Transfert()
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
Range("P2:Y65536").ClearContents
For i = 2 To 65536
If Cells(i, 1) = "" Then Exit Sub
For j = 10 To 15
If Cells(i, j) <> "" Then
If Cells(i, 16) = "" And Cells(i, 17) = "" Then
Cells(i, 17) = Cells(i, j)
Cells(i, 16) = Cells(1, j)
ElseIf Cells(i, 18) = "" And Cells(i, 19) = "" Then
Cells(i, 19) = Cells(i, j)
Cells(i, 18) = Cells(1, j)
ElseIf Cells(i, 20) = "" And Cells(i, 21) = "" Then
Cells(i, 21) = Cells(i, j)
Cells(i, 20) = Cells(1, j)
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

Merci par avance,

Cordialement.

 

[Maud44]

Re : Extraction de données dans cellules différentes

Sub Transfert()
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
Range("P2:X65536").ClearContents
For i = 2 To 65536
If Cells(i, 1) = "" Then Exit Sub
For j = 10 To 15
If Cells(i, j) <> "" Then
If Cells(i, 16) = "" And Cells(i, 17) = "" Then
Cells(i, 17) = Cells(i, j)
Cells(i, 16) = Cells(1, j)
ElseIf Cells(i, 18) = "" And Cells(i, 19) = "" Then
Cells(i, 19) = Cells(i, j)
Cells(i, 18) = Cells(1, j)
ElseIf Cells(i, 20) = "" And Cells(i, 21) = "" Then
Cells(i, 21) = Cells(i, j)
Cells(i, 20) = Cells(1, j)
ElseIf Cells(i, 22) = "" And Cells(i, 23) = "" Then
Cells(i, 23) = Cells(i, j)
Cells(i, 22) = Cells(1, j)
ElseIf Cells(i, 24) = "" And Cells(i, 25) = "" Then
Cells(i, 25) = Cells(i, j)
Cells(i, 24) = Cells(1, j)
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

Ca à l'air de fonctionner comme ca