[gilbert_RGI]

Bonjour

un truc dans le genre ?

la feuille copiée et la feuille de recopie sont à déterminer

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
'--------------------------------

Cdlt
RGI