re "Guillaume"
je joins le code avec un ajout en Gras
tu peux aussi ajouter un bouton en page patient et y coller la macro
Sub transfertNom()
Dim cel As Range
Dim VdateCal As Long, VdateDebut As Long, VdateFin As Long
Dim Tab1 As Variant, Tab2 As Variant, Tab3 As Variant
Dim derlgn As Byte, derlgn2 As Byte, lgn As Byte, nCol As Byte, nPatient As Integer
Application.ScreenUpdating = False
With Workbooks("patientx").Sheets("Données")
.Activate
derlgn = .Range("B65536").End(xlUp).Row
Tab1 = .Range("B12:I" & derlgn).Value
nPatient = UBound(Tab1, 1)
End With
With Workbooks("journal_kine").Sheets("Janvier")
.Activate
.Range("B333").ClearContents'efface la zone avant réinscription si modif en page patient
derlgn2 = .Range("A65536").End(xlUp).Row
nCol = 1
For nPatient = 1 To UBound(Tab1, 1)
For Each cel In .Range("A3:A" & derlgn2)
VdateCal = Format(cel.Value, "00000")
VdateDebut = Format(Tab1(nPatient, 6), "00000")
VdateFin = Format(Tab1(nPatient, 8), "00000")
If VdateCal > VdateDebut And VdateCal < VdateFin Then
cel.Offset(0, nCol) = Tab1(nPatient, 1) & "-" & Tab1(nPatient, 5)
End If
Next
nCol = nCol + 1
Next
End With
Application.ScreenUpdating = True
End Sub
A+++
Jean Marie