Pb avec une macro

Option Explicit

Function GetFormat(ByVal Cell As Range)
GetFormat = Cell.NumberFormat
End Function

Sub AfficheFormats()
Dim NomFeuille As String
Dim LastCol As Integer
Dim LastRow As Long
Dim RBase As Range, RFirstRow As Range, RFirstCol As Range
Dim RWholePlage As Range


    With ActiveSheet
        LastRow = .Range('A65536').End(xlUp).Row
        LastCol = .Range('IV1').End(xlToLeft).Column
        NomFeuille = .Name
    End With

ActiveWorkbook.Sheets.Add after:=ActiveSheet
   
    With Application
    .DisplayAlerts = False
        On Error Resume Next
        Sheets(NomFeuille & '-Formats').Delete
        ActiveSheet.Name = NomFeuille & '-Formats'
        On Error GoTo 0
    .DisplayAlerts = True
    End With

Set RBase = Range('A1')
Set RFirstRow = Range(Cells(1, 1), Cells(1, LastCol))
Set RFirstCol = Range(Cells(1, 1), Cells(LastRow, LastCol))
Set RWholePlage = Range(Cells(1, 1), Cells(LastRow, LastCol))
RBase.Formula = '=GetFormat(' & NomFeuille & '!A1)'

    On Error GoTo Out1
        RBase.AutoFill Destination:=RFirstRow, Type:=xlFillDefault
        On Error GoTo Out2
            RFirstRow.AutoFill Destination:=RWholePlage, Type:=xlFillDefault
            Application.CalculateFull
                Exit Sub

Out1:
    On Error GoTo 0
        On Error GoTo DefinitlyOut 'LOL !!
        RBase.AutoFill Destination:=RFirstCol, Type:=xlFillDefault
        MsgBox 'la feuille ne contenait qu'une seule colonne de données'
        Application.CalculateFull
Exit Sub
Out2:
    RBase.AutoFill Destination:=RFirstRow, Type:=xlFillDefault
    MsgBox 'la feuille ne contenait qu'une seule ligne de données'
    Application.CalculateFull
Exit Sub
DefinitlyOut:
MsgBox 'la feuille ne contenait qu'une seule cellule de données'
End Sub

Cliquez pour agrandir...