Unprotect and protect sheet in a macro
 

Hello

When I run this macro half the time I get a fault in the paste special line,
The worksheet I paste into is protected (no password) so in the beginning I
unprotect it and in the end I protect it. It says the pastespecial method
is not working. Help me please, it drives me nuts. If the sheet is not
protected in the beginning all is working fine.

Sub kopiera()

Application.ScreenUpdating = False
Sheets("Faktura").Activate
Range("J5").Select
Selection.Copy
Workbooks.Open Filename:="C:\Excelprojekt/Faktura Åkeri\Reskontra1.xls"
Windows("Reskontra1.xls").Activate
Sheets("Reskontra").Activate
Sheets("Reskontra").Unprotect
Columns("A:A").Select
Selection.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 0).Range("a1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False

Windows("Faktura.xls").Activate
Sheets("Faktura").Activate
Range("G5").Select
Selection.Copy
Windows("Reskontra1.xls").Activate
Sheets("Reskontra").Activate
Columns("B:B").Select
Selection.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 0).Range("a1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Sheets("Reskontra").Protect
ActiveWorkbook.Save
ActiveWindow.Close



ActiveWorkbook.SaveAs Filename:="c:\Excelprojekt/Faktura
Åkeri\Fakturor\" & Range("G5") - 1 & "xls", FileFormat:=xlNormal,
Password:="", WriteResPassword:="", ReadOnlyRecommended:=True,
CreateBackup:=False

Sheets("Faktura").Select
Range("A21:B36").Select
Selection.ClearContents
Range("H5").Select
Selection.ClearContents
Range("H21:I36").Select
Selection.ClearContents

Range("A21").Select

Application.ScreenUpdating = True

ActiveWorkbook.SaveAs Filename:="C:\Excelprojekt/Faktura
Åkeri\Faktura.xls", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False

Application.Quit

End Sub

TIA

Ola Sigurdh

Unprotect and protect sheet in a macro
 

It's difficult to tell what's going on, but instead of using all the selects,
maybe you could use something like:

Option Explicit
Sub testme()

Dim wkbk As Workbook
Dim FoundCell As Range

Set wkbk = Workbooks.Open _
(Filename:="C:\Excelprojekt/Faktura Åkeri\Reskontra1.xls")

With wkbk.Worksheets("Reskontra")
With .Range("a:a")
Set FoundCell = .Cells.Find(what:="whatever", _
after:=.Cells(.Cells.Count), _
rest of .find command here)

End With

If FoundCell Is Nothing Then
MsgBox "not found"
Else
.Unprotect
FoundCell.Value _
= Workbooks("faktura.xls").Worksheets("faktura").Ran ge("a6")
.Protect
End If

End With

End Sub

I'm guessing that something is killing the contents of the clipboard--but since
you're just pasting values, you could just assign the values.

But you'll have to test it. I had no idea what to findnext or what the parms of
..Find should be (xlwhole/xlpart, etc).



Ola Sigurdh wrote:

Hello

When I run this macro half the time I get a fault in the paste special line,
The worksheet I paste into is protected (no password) so in the beginning I
unprotect it and in the end I protect it. It says the pastespecial method
is not working. Help me please, it drives me nuts. If the sheet is not
protected in the beginning all is working fine.

Sub kopiera()

Application.ScreenUpdating = False
Sheets("Faktura").Activate
Range("J5").Select
Selection.Copy
Workbooks.Open Filename:="C:\Excelprojekt/Faktura Åkeri\Reskontra1.xls"
Windows("Reskontra1.xls").Activate
Sheets("Reskontra").Activate
Sheets("Reskontra").Unprotect
Columns("A:A").Select
Selection.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 0).Range("a1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False

Windows("Faktura.xls").Activate
Sheets("Faktura").Activate
Range("G5").Select
Selection.Copy
Windows("Reskontra1.xls").Activate
Sheets("Reskontra").Activate
Columns("B:B").Select
Selection.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 0).Range("a1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Sheets("Reskontra").Protect
ActiveWorkbook.Save
ActiveWindow.Close

ActiveWorkbook.SaveAs Filename:="c:\Excelprojekt/Faktura
Åkeri\Fakturor\" & Range("G5") - 1 & "xls", FileFormat:=xlNormal,
Password:="", WriteResPassword:="", ReadOnlyRecommended:=True,
CreateBackup:=False

Sheets("Faktura").Select
Range("A21:B36").Select
Selection.ClearContents
Range("H5").Select
Selection.ClearContents
Range("H21:I36").Select
Selection.ClearContents

Range("A21").Select

Application.ScreenUpdating = True

ActiveWorkbook.SaveAs Filename:="C:\Excelprojekt/Faktura
Åkeri\Faktura.xls", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False

Application.Quit

End Sub

TIA

Ola Sigurdh

--

Dave Peterson