Hierbij de macro; het bestand is waarschijnlijk te groot om te verzenden.Mijn probleem zit in : Worksheet ("blad1").
Zodoende kan ik de macro niet toepassen op b.v Blad2.
Ik hoop dat iemand een oplossing heeft Romian
Sub Macro1()
'
' Macro1 Macro
'
' Sneltoets: CTRL+SHIFT+V
'
ActiveSheet.Unprotect
Range("A6").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(3, 0).Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(-3, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Range("A1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = xlAutomatic
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A6").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort.SortFields.Add Key:= _
ActiveCell.Offset(-1, 1).Range("A1:A23"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$6:$DX$60").AutoFilter Field:=2
ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort.SortFields.Add Key:= _
ActiveCell.Offset(0, 1).Range("A1:A23"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Blad1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
Selection.AutoFilter
Range("A6").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 8).Range("A1:I1").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-1]C[-7]=0,""U KUNT NIEUW DECLARATIENUMMER INVULLEN "",""U KUNT NIEUWE REGEL AANMAKEN Shift+Contr+V "")"
Range("A6").Select
Range("A6").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub