Sub Remplir()
Dim i As Byte
Dim c As Range
Dim ref As Worksheet
Dim chemin as String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
chemin = 'C:\\le nom du dossiers dans le répertoire pour arriver au fichier\\'
Workbooks.Open Filename:=chemin & 'Charlotte.xls'
Set ref = Workbooks(1).Worksheets('sheet1') 'reference à la feuille 1
With Workbooks('charlotte.xls').Sheets('Sheet2')
For Each c In .Range('A1:H1')
If c = ref.Range('A1') Then
i = .Cells(65536, c.Column).End(xlUp).Row + 1
.Cells(i, c.Column) = ref.Range('A2')
.Cells(i + 1, c.Column) = ref.Range('A3')
End If
Next c
End With
Application.ScreenUpdating = True
End Sub