Macro Sorting not working correctly

[bbqsmokeman]

Hello
I had a working macro I recorded to sort a range (A14:I500) and then insert a blank row at A14:J14 and it worked fine till I realized it didn't carry over the drop down lists some of the cells had that were using 'name manager' data. So i tried to change the code to copy A14:J14 from a hidden sheet (has the predetermined cells with drop downs etc) and paste into the sheet then hide the sheet again but I get an error 1004.
I am also trying to make the macro not sheet specific but having issues with that as well sine the macro recorded the sheet I was on. I don't want to create possibly 30 macros for all the sheets that one may have and then if new sheets are added then redo it.
Here is the code I created. So I created a new macro to try and eliminate the specific sheet reference and still received the error 1004 even if I made the sheet visible I was copying from.

Sub KeepSorted()

Dim sh As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'For Each sh In Worksheets
  'If ws.name <> "2016 - 2021 Calendar Replace" And ws.name <> "Manager Summary" Then
  'sh.Select
With Range("A14:I500" & Cells(Rows.Count, "A").End(xlUp).Row)
    .Sort Key1:=Range("A14"), _
    Order1:=xlDescending, _
    Header:=xlNo, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortTextAsNumbers
End With
Sheets("COPYTHISFORNewEmployee").Select
    Range("A14:K14").Select
    Selection.Copy

With Range("A14:J14").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Is there a way to maintain the structure of the range A14:J14 (Name manager, drop down lists etc) when inserting the blank row without copying from another sheet that is hidden or can the macro copy from the hidden file without opening it and insert the range to keep the drop down list cells intact?

 

[vletm]

Links are great ... if those could work!
I could see only empty sheets (without data => cannot test!)
but this would do something...

Sub KeepSorted()
    Dim sh As Worksheet
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
'For Each sh In Worksheets
  'If ws.name <> "2016 - 2021 Calendar Replace" And ws.name <> "Manager Summary" Then
  'sh.Select
    With Range("A14:I500" & Cells(Rows.Count, "A").End(xlUp).Row)
        .Sort Key1:=Range("A14"), _
        Order1:=xlDescending, _
        Header:=xlNo, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
    End With
    Range("A14:J14").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("COPYTHISFORNewEmployee").Range("A14:K14").Copy Destination:=Range("A14")
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[bbqsmokeman]

Vletm
Thanks I will test the code and yes I know the drop down cells are blank because I have to re-associate the name manager lists and will let you know how it works and when I get the name manager lists redone so it shows what is supposed to be in each.

thanks for your help

 

[bbqsmokeman]

Vletm

code works great! I looked over the changes and now see where I went wrong with the 2 lines. I ran it on the sample and worked great! I ran it on the true workbook and it worked fantastic!

Thank you!