Feuille récapitulative

Private Sub Worksheet_Activate()
Dim lig&, ncol%, w As Worksheet
Application.ScreenUpdating = False
Rows("7:" & Rows.Count).Delete 'RAZ
lig = 6 '1ère ligne, à ne pas modifier
ncol = Cells(lig, Columns.Count).End(xlToLeft).Column
For Each w In Worksheets
  If w.Name <> Me.Name Then
    lig = lig + 1
    Cells(lig, 1) = w.Name
    With w.[A7].Resize(, ncol)
      .Copy Cells(lig, 1) 'pour copier les formats
      Cells(lig, 1).Resize(, ncol) = .Value 'valeurs
    End With
    Cells(lig, 1) = w.Name
  End If
Next
End Sub

Private Sub Worksheet_Activate()
Dim lig&, w As Worksheet, col As Variant
lig = 5 '1ère ligne, à adapter
Application.ScreenUpdating = False
Rows(lig & ":" & Rows.Count).Delete 'RAZ
Me.DrawingObjects.Delete 'supprime les objets
For Each w In Worksheets
  If w.Name <> Me.Name Then
    Cells(lig, 1) = w.Name
    col = Application.Match("X", w.Rows(7), 0)
    If IsNumeric(col) Then
      w.Cells(7, col).CopyPicture 'photo
      Me.Paste
      With Selection
        .Left = Cells(lig, 2).Left
        .Top = Cells(lig, 2).Top
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = Cells(lig, 2).Width
        .Height = Cells(lig, 2).Height
      End With
      Cells(lig, 3) = CDate(w.Cells(6, col)) 'date
    End If
    lig = lig + 1
  End If
Next
ActiveCell.Activate
End Sub

Private Sub Worksheet_Activate()
Dim lig&, w As Worksheet, col As Variant
lig = 5 '1ère ligne, à adapter
Application.ScreenUpdating = False
Rows(lig & ":" & Rows.Count).Delete 'RAZ
Me.DrawingObjects.Delete 'supprime les objets
For Each w In Worksheets
  If w.Name <> Me.Name Then
    Cells(lig, 1) = w.Name
    col = Application.Match("X", w.Rows(7), 0)
    If IsNumeric(col) Then
      w.Cells(6, col).Copy Cells(lig, 2) 'date
      w.Cells(7, col).CopyPicture 'photo du "X"
      Me.Paste
      With Selection
        .Left = Cells(lig, 3).Left
        .Top = Cells(lig, 3).Top
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = Cells(lig, 3).Width
        .Height = Cells(lig, 3).Height
      End With  
    End If
    lig = lig + 1
  End If
Next
ActiveCell.Activate
End Sub

Private Sub Worksheet_Activate()
Dim i&, w As Worksheet, col As Variant
Application.ScreenUpdating = False
Rows("6:" & Rows.Count).Delete 'RAZ
For i = Worksheets.Count To 1 Step -1
  Set w = Worksheets(i)
  If w.Name <> Me.Name Then
    Rows(6).Insert 'décale l'existant vers le bas
    Cells(6, 1) = w.Name
    col = Application.Match("X", w.Rows(7), 0)
    If IsNumeric(col) Then
      Rows(6).Insert
      w.Cells(6, col).Copy Cells(7, 2) 'date
      w.Cells(6, col).Resize(2).Copy Cells(6, 3)
      Cells(7, 3) = "X"
      Rows(6).Hidden = True 'la ligne est masquée
    End If
  End If
Next
End Sub

Private Sub Worksheet_Activate()
Dim w As Worksheet, maxi%, i%, col As Variant
Application.ScreenUpdating = False
Rows("6:" & Rows.Count).Delete 'RAZ
'---numéro maximum des feuilles---
For Each w In Worksheets
  If Val(w.Name) > maxi Then maxi = Val(w.Name)
Next w
'---copie des cellules "X"---
For i = maxi To 1 Step -1
  For Each w In Worksheets
    If Val(w.Name) = i Then
      Rows(6).Insert 'décale l'existant vers le bas
      Cells(6, 1) = w.Name
      col = Application.Match("X", w.Rows(7), 0)
      If IsNumeric(col) Then
        Rows(6).Insert
        w.Cells(6, col).Copy Cells(7, 2) 'date
        w.Cells(6, col).Resize(2).Copy Cells(6, 3)
        Cells(7, 3) = "X"
        Rows(6).Hidden = True 'la ligne est masquée
      End If
      Exit For
    End If
Next w, i
End Sub