XL 2013 problème avec ActiveWorkbook.Save

[Litan44260]

Bonjour à tous ,
Je vous contact car j'ai plus de solution
J'ai un fichier excel qui réalise des action par VBA et a la fin il réalise un

ActiveWorkbook.Save

sauf que il refuse toujours de le réaliser et génère un fichier tmp

Je ne sais pas comment faire
Quelqu'un a déjà eu ce problème

 

[fanch55]

Salut, un fichier exemple expurgé serait le bienvenu ...

 

[Litan44260]

Bonjour ,
Oui pardon j'ai oublier je suis désolé
Explication j'ouvre un fichier 1.xlsm
je fais un unprotect
je retourne dans mon fichier d'origine pour copier les donnée de A27:S:27
je colle + trie donnée
je rallume le unprotect
et je sauvegarde et la ça plante

    With ThisWorkbook
    Workbooks.Open ("1.xlsm")
    Set wbks = ActiveWorkbook
    
    Windows("1.xlsm").Activate

ActiveSheet.Unprotect ("*****")
       Windows("origine.xlsm").Activate
     Sheets("feuilorigine").Select
    Range("A27:S27").Select
    Selection.Copy
    Windows("1.xlsm").Activate


 ActiveWindow.SmallScroll Down:=48
    Range("A6000").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-57
    Range("A5:t6000").Select
    ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Add Key:=Range("A5:A17" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Archive").Sort
        .SetRange Range("A5:t6000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Protect Password:="********", DrawingObjects:=True, Contents:=True, Scenarios:=True

     ActiveWorkbook.Save
   wbks.Close False
    End With

 

[fanch55]

Bonsoir,
J'aurai plutôt vu cela comme ci-dessous

Sub Test()
Dim Sh As Worksheet, Psw As String
    Psw = "toto"
    With Workbooks.Open("D:\.................\1.xlsm")
        Set Sh = .Worksheets("Archive")
            With Sh
                .Activate
                .Unprotect Psw
                ThisWorkbook.Worksheets("feuilorigine").Range("A27:S27").Copy
                .Range("A6000").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .Range("A6000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                With .Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=Sh.Range("A5:A17"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                    .SetRange Sh.Range("A5:T6000")
                    .Header = xlGuess: .MatchCase = False
                    .Orientation = xlTopToBottom: .SortMethod = xlPinYin
                    .Apply
                End With
                .Protect Psw, DrawingObjects:=True, Contents:=True, Scenarios:=True
            End With
        Set Sh = Nothing
        .Close True
    End With
End Sub

 

[Litan44260]

Merci j'ai réaliser la modification que tu as proposer + réimager le pc