Sub Remplir()
Dim Rg As Range, C As Range
On Error Resume Next
Set mybook = ThisWorkbook
fileToOpen = Application _
.GetOpenFilename("fichiers excel (*.xls),*.xls")
'If fileToOpen <> False Then
' MsgBox "Open " & fileToOpen
'End If
Workbooks.Open fileToOpen
With mybook.Sheets("Feuil1") 'à déterminer
Set Rg = .Range("A1:J" & DerLig(Worksheets(.Name)))
On Error Resume Next
For Each C In Rg.Columns
C.SpecialCells(xlCellTypeConstants).Copy _
Worksheets("Feuil2").Cells(1, C.Column)
'Nom Feuille à déterminer
Next
End With
Set C = Nothing
End Sub
'--------------------------------
Function DerLig(sh As Worksheet)
On Error Resume Next
DerLig = sh.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
End Function
'--------------------------------