[RÉSOLU] Remplacer Cellule par Feuille

[un internaute]

Bonjour le forum
J'ai cette macro
Je voudrais remplacer les 2 lignes ci-dessous
Q.Cells(N, 3).Value = Range("K10") ' Nom du médecin
Q.Cells(N, 4).Value = Range("L10") ' Nom du Kiné ou de l'Ostéo

par le nom d'une feuille que j'ai crée => LISTE_PRATICIENS
K10 remplacé par A2
L10 remplacé par B2

 

[un internaute]

Bonjour Lone-wolf

Voilà ça fonctionne grace à toi
Un GRAND merci
Je m'excuse pour la mauvaise explication mais c'est de ma faute comme d'hab!!!
Bonne journée
Cordialement

Option Explicit

Sub AjouteSeance()
Dim J As Long
'Dim Sh As Shape
Dim Serie As Integer, N As Integer
Dim Q As Range

Dim Cel As Range

  For J = 3 To 8
    If Range("C" & J) <> 0 Then
      Serie = J - 2

      ActiveSheet.Unprotect
      Set Q = Range("Serie" & Serie)
      For N = 1 To Q.Rows.Count
        If Q.Cells(N, 1) = "" Then
        If Not IsError(Application.Match(CSng(Date), Columns("A"), 0)) Then        'Interdire séance le même jour
            MsgBox "Une séance existe déjà à cette date"                           'Interdire séance le même jour
          Else                                                                     'Interdire séance le même jour
            Q.Cells(N, 1).Value = 1
            Q.Cells(N, 1).Interior.ColorIndex = 3
            Q.Cells(N, 3).Value = Sheets("LISTE_PRATICIENS").Range("D2")        'Range("D2")      ' Nom du médecin
            Q.Cells(N, 4).Value = Sheets("LISTE_PRATICIENS").Range("E2")        'Range("E2")      ' Nom du Kiné ou de l'Ostéo
            Q.Cells(N, 2).Value = Cells(Serie + 2, "C")
            Q.Cells(N, 2).Interior.ColorIndex = 15
            Application.Goto Q.Cells(1, 1).Offset(-1), Scroll:=True
          End If                                                                   'Interdire séance le même jour
          Exit For
        End If
      Next N
      ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
          Scenarios:=True
      Exit Sub
    End If
  Next J
   MsgBox " Impossible d'afficher la séance pour les raisons suivantes :" & vbCr & vbCr & " 1 - Série terminée" & vbCr & vbCr & " 2 - Renseigner le nombre de séances prescrites pour la prochaine série" & vbCr & vbCr & " 3 - Toutes les séries sont complètes"

End Sub