Bonjour à tous,
J’ai les codes suivants en copiant des données de l’onglet Détail et de les coller dans l’onglet “Historik”.
Le problème c’est que ces deux onglets ne peuvent pas être protégés pour que la macro soit exécuté.
Je voudrais que ces feuilles soient protégés et qu’en lançant un bouton, il n’y a pas de problème.
Ci-après les codes:
Sub nouveauenregistrement()
’
’ nouveauenregistrement Macro
’ ajout de données
’
Application.ScreenUpdating = False
Range(“D11”).Select
Range(“D11”).Copy
Range(“D10”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(“Historik”).Select
Rows(“13:13”).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(“A13”).Select
Sheets(“Détail”).Select
Range(“D8”).Select
Selection.Copy
Sheets(“Historik”).Select
Range(“C13”).Select
ActiveSheet.Paste
Sheets(“Détail”).Select
Range(“D5”).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(“Historik”).Select
Range(“D13”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(“Détail”).Select
Range(“D6”).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(“Historik”).Select
Range(“E13”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(“Détail”).Select
Range(“D7”).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(“Historik”).Select
Range(“F13”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(“Détail”).Select
ActiveWindow.SmallScroll Down:=9
Range(“E24”).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(“Historik”).Select
Range(“G13”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(“Détail”).Select
Range(“E26”).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(“Historik”).Select
Range(“H13”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“G13:H13”).Select
Application.CutCopyMode = False
Selection.NumberFormat = “###,###”" Ar"""
Range(“I3”).Select
Selection.Copy
Range(“B13”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“B13:H13”).Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
Range(“B13”).Select
Selection.Copy
Sheets(“Détail”).Select
ActiveWindow.SmallScroll Down:=-12
Range(“D4”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ExecuteExcel4Macro “PRINT(2,1,1,1,2,TRUE,FALSE)”
Sheets(“Historik”).Select
Range(“Tableau4[#Headers]”).Select
Selection.AutoFilter
Range(“Tableau4[[#Headers],[N°]]”).Select
ActiveWorkbook.Worksheets(“Historik”).ListObjects(“Tableau4”).Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets(“Historik”).ListObjects(“Tableau4”).Sort.SortFields. _
Add Key:=Range(“Tableau4[[#All],[N°]]”), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(“Historik”).ListObjects(“Tableau4”).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range(“Tableau4[#Headers]”).Select
Selection.AutoFilter
Columns(“D:F”).Select
With Selection
.HorizontalAlignment = xlLeft
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(“Tableau4[[#Headers],[NOM ET PRENOMS]:[DIRECTION]]”).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(“E2”).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns(“G:H”).Select
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(“Tableau4[[#Headers],[MONTANT FACTURE]:[MONTANT REMBOURSABLE]]”).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Vous remerciant par avance,
Cordialement,