Sub Copie_Structure_Feuille_Valeur_Format_Commentaire()
'Dim t1 As Long, NomFAct As String, DerCelSel As Variant, DerCelAdr As Variant, NBcol As Long, NBLig As Long, cell As Range, i As Long
Dim LargCol(1048576), HautLig(1048576) ', DercelLig As Long, DerCelCol As Long, Ilig As Long, ICOl As Long
t1 = Timer
Application.ScreenUpdating = False
NomFAct = ActiveSheet.Name
DerCelSel = ActiveCell.SpecialCells(xlLastCell).Select
DerCelAdr = ActiveCell.Address: DerCelCol = ActiveCell.Column: DercelLig = ActiveCell.Row
NBcol = 0
For ICOl = 1 To DerCelCol
If Cells(1, ICOl).ColumnWidth <> 0 Then NBcol = NBcol + 1: LargCol(NBcol) = Cells(1, ICOl).ColumnWidth
Next
NBLig = 0
For Ilig = 1 To DercelLig
If Rows(Ilig & ":" & Ilig).RowHeight <> 0 Then NBLig = NBLig + 1: HautLig(NBLig) = ActiveSheet.Rows(Ilig & ":" & Ilig).RowHeight
Next
'Stop
' A voir pour traitement de type Tableau
'For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(DercelLig, DerCelCol))
'Traitement tableau
'Next
Sheets.Add
For i = 1 To NBcol
Cells(1, i).ColumnWidth = LargCol(i)
Next
For i = 1 To NBLig
Rows(i & ":" & i).RowHeight = HautLig(i)
Next
ActiveSheet.Next.Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
ActiveSheet.Previous.Select
Range("A1").Select
'Mettre pour chaque cellule la valeur et le format et le commentaire
'Posibilité de mettre la formule avec xlPasteFormulas mais commenter xlPasteValues
'Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
If Len(NomFAct) < 27 Then ActiveSheet.Name = "CV " & NomFAct Else ActiveSheet.Name = "CV " & Mid(NomFAct, 1, 14) & Right(NomFAct, 14)
Application.ScreenUpdating = True
MsgBox Timer - t1
End Sub