Macro  recopie absences

Sub recopie_cellule(ligne_source As Integer, col_source As Integer, ligne_but As Integer, col_but As Integer)
'
' recopie_cellule Macro
'

'
    Sheets("Abscences").Select
    Cells(ligne_source, col_source).Select
    Selection.Copy
    Sheets("Planning").Select
    Cells(ligne_but, col_but).Select
    ActiveSheet.Paste
End Sub



Public Function cherche_ligne_du_nom(nom As String) As Integer
Dim ligne As Integer
ligne = 3
While planning.Cells(ligne, 2) <> nom And planning.Cells(ligne, 2) <> ""
  ligne = ligne + 1
Wend
If planning.Cells(ligne, 2) = "" Then
    MsgBox "ce nom n'existe pas dans la feuille planning"
End If
cherche_ligne_du_nom = ligne
End Function


Public Function recherche_colonne_de_date(jour As Date) As Integer
Dim colonne As Integer
colonne = 5
'format(MyDate,"dd/mm/yyyy")
ma_date = planning.Cells(2, 5)
While ma_date <> jour And ma_date <> ""
  colonne = colonne + 1
  ma_date = planning.Cells(2, colonne)

Wend

recherche_colonne_de_date = colonne

End Function




Public Function recherche_couleur_cellule(ligne As Integer, col As Integer) As Boolean
   If absence.Cells(ligne, col).Interior.Color <> 16777215 Then
       recherche_couleur_cellule = True
      Else
       recherche_couleur_cellule = False
  End If
End Function

Public Sub test()
x = recherche_couleur_cellule(3, 2)
End Sub

Public Sub recopie_absence()
Dim ligne As Integer
Dim col As Integer
Dim ligne_planning As Integer
Dim col_planning As Integer
col = 2
ligne = 2
nb_col_planning = planning.Cells(1, Columns.Count).End(xlToLeft).Column
While absence.Cells(1, col) <> ""
  
   While absence.Cells(ligne, 1) <> ""
     If recherche_couleur_cellule(ligne, col) Then
        ligne_planning = cherche_ligne_du_nom(absence.Cells(ligne, 1))
        col_planning = recherche_colonne_de_date(absence.Cells(1, col))
        If col_planning <= nb_col_planning Then
           Call recopie_cellule(ligne, col, ligne_planning, col_planning)
        End If
        'MsgBox "recopie ligne " & ligne & "col " & col
     End If
     ligne = ligne + 1
   Wend
   col = col + 1
   ligne = 2
Wend
     
    

End Sub



test

Sub recopie_cellule(ligne_source As Integer, col_source As Integer, ligne_but As Integer, col_but As Integer)
'
' recopie_cellule Macro
'

'
    Sheets("Abscences").Select
    Cells(ligne_source, col_source).Select
    Selection.Copy
    Sheets("Planning").Select
    Cells(ligne_but, col_but).Select
    ActiveSheet.Paste
End Sub



Public Function cherche_ligne_du_nom(nom As String) As Integer
Dim ligne As Integer
ligne = 3
While planning.Cells(ligne, 2) <> nom And planning.Cells(ligne, 2) <> ""
  ligne = ligne + 1
Wend
If planning.Cells(ligne, 2) = "" Then
    MsgBox "ce nom n'existe pas dans la feuille planning"
End If
cherche_ligne_du_nom = ligne
End Function


Public Function recherche_colonne_de_date(jour As Date) As Integer
Dim colonne As Integer
colonne = 5
'format(MyDate,"dd/mm/yyyy")
ma_date = planning.Cells(2, 5)
While ma_date <> jour And ma_date <> ""
  colonne = colonne + 1
  ma_date = planning.Cells(2, colonne)

Wend

recherche_colonne_de_date = colonne

End Function




Public Function recherche_couleur_cellule(ligne As Integer, col As Integer) As Boolean
   If absence.Cells(ligne, col).Interior.Color <> 16777215 Then
       recherche_couleur_cellule = True
      Else
       recherche_couleur_cellule = False
  End If
End Function

Public Sub test()
x = recherche_couleur_cellule(3, 2)
End Sub

Public Sub recopie_absence()
Dim ligne As Integer
Dim col As Integer
Dim ligne_planning As Integer
Dim col_planning As Integer
col = 2
ligne = 2
nb_col_planning = planning.Cells(1, Columns.Count).End(xlToLeft).Column
While absence.Cells(1, col) <> ""
  
   While absence.Cells(ligne, 1) <> ""
     If recherche_couleur_cellule(ligne, col) Then
        ligne_planning = cherche_ligne_du_nom(absence.Cells(ligne, 1))
        col_planning = recherche_colonne_de_date(absence.Cells(1, col))
        If col_planning <= nb_col_planning Then
           Call recopie_cellule(ligne, col, ligne_planning, col_planning)
        End If
        'MsgBox "recopie ligne " & ligne & "col " & col
     End If
     ligne = ligne + 1
   Wend
   col = col + 1
   ligne = 2
Wend
     
    

End Sub