Private Sub Workbook_Activate()
Dim chemin$, nomfich$, nomfeuille$, wb As Workbook
Dim F As Worksheet, tablo, j%, k%, i&
chemin = ThisWorkbook.Path & "\" 'à adapter
nomfich = "PLANNING PR FORUM.xlsx" 'nom et extension à adapter
nomfeuille = "JANVIER14" 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
Set wb = Workbooks(nomfich)
If wb Is Nothing Then Set wb = Workbooks.Open(chemin & nomfich)
If wb Is Nothing Then MsgBox "Fichier source introuvable": GoTo 1
Set F = wb.Sheets(nomfeuille)
If F Is Nothing Then MsgBox "Feuille source introuvable": GoTo 1
Me.Activate: Sheets(1).Activate '1ère feuille, à adapter
tablo = F.UsedRange
For j = 1 To 15 'colonnes A à O
k = IIf(j < 5, j, j + 1)
For i = 2 To UBound(tablo) 'titres en 1ère ligne
Cells(i, k) = tablo(i, j) 'transfert
Next
For i = i To ActiveSheet.UsedRange.Rows.Count
Cells(i, k) = "" 'effacement
Next
Next
1 Application.EnableEvents = True 'réactive les évènements
End Sub