hjælp til finpusning af makro - blinker en del

Er der nogle der vil hjælpe med at minimere mine blink ;O) Hopper lidt frem og tilbage. Har forsøgt lidt men så fungerer det ikke optimalt. Forslag?

Rem denne aktiveres ved ny kunde og henter instruktion, label og OBS+nyheder
Private Sub CommandButton1_Click()
Dim kundenr, batch
fil = "\\sti\" '& [F6] & "v.xls" 'benyttes kun i produktion
fil_obs = "\\sti\Dagens_tip_OBS.xls" ' benyttes kun i prod

ActiveSheet.Unprotect Password:="kode" 'låser startsiden op
       
        ActiveWorkbook.Sheets("startside").Cells(6, 6).Value = UserForm1.TextBox1.Value 'indsætter kundenummer i F6
        kundefil = fil & [F6] & "v.xls"

Sheets("pakkeinstruktion").Unprotect Password:="kode" 'låser pakkeinstruktionarket op

Sheets("pakkeinstruktion").UsedRange.ClearContents 'sletter data i arket pakkeinstruktioner
For Each pic In Sheets("pakkeinstruktion").Shapes    ' sletter label i arket pakkeinstruktioner
        If pic.Type = 13 Then
      pic.Delete
          End If
    Next
'ActiveSheet.Protect Password:="kode"
        If Dir(kundefil) = "" Then    'fejlmeddelse hvis der ikke findes en pakkeinstruktion med det indtastede nummer
        MsgBox ("Du har tastet et kundenummer, der ikke eksisterer")
        ActiveSheet.Cells(9, 2) = ""
        UserForm1.TextBox1.Value = ""
        ActiveSheet.Cells(6, 6) = ""
        Sheets("pakkeinstruktion").Protect Password:="kode"
        UserForm1.TextBox1.SetFocus
       
       
        Exit Sub ' går ud
      Sheets("pakkeinstruktion").Protect Password:="kode"
 
   
    Else ' hvis instruktionen findes
    Rem insaætter dagens tip og OBS til brugeren
       
       
    Workbooks.Open Filename:=fil_obs
    ActiveWorkbook.Sheets(1).Range("C2").Copy ThisWorkbook.Sheets("startside").Range("F24") 'Dagens tip indsættes
    ActiveWorkbook.Sheets(1).Range("C3").Copy ThisWorkbook.Sheets("startside").Range("F25") 'Dagens tip indsættes
    ActiveWorkbook.Sheets(1).Range("C6").Copy ThisWorkbook.Sheets("startside").Range("F27") 'OBS indsættes
    ActiveWorkbook.Sheets(1).Range("C7").Copy ThisWorkbook.Sheets("startside").Range("F28") 'OBS indsættes

    ActiveWorkbook.Close savechanges:=False
    Rem lukker dagens tip fil
   
   
   
    ActiveWorkbook.Sheets(1).Cells(9, 2) = "ok" 'skriver ok i celle b9, denne benyttes til lopslag på startsiden
 
   
    Rem sætter en kopi af pakkeinstruktionen ind på ark2
     
   
    Workbooks.Open Filename:=kundefil    ' F6 = kundenr.
   
   
    ActiveWorkbook.Sheets("NY version").Range("A1:F200").Copy ThisWorkbook.Sheets("pakkeinstruktion").Range("a1") ' hele instruktionen kopieres over i Ark 1 og der laves opslag herfra.
    For Each pic In ActiveSheet.Shapes    ' kopieres label med over
        If pic.Type = 13 Then
      pic.Copy
       
        End If
     
    Next
   
   
    ActiveWorkbook.Close savechanges:=False 'lukker pakkeinstruktionsfilen der er kopieret fra igen uden at gemme
       
        Sheets("pakkeinstruktion").Activate 'aktiverer instruktionsarket og sætter billede ind
        ActiveSheet.Range("B60").Select
        ActiveSheet.Paste
        ActiveSheet.Range("a1").Select
    ActiveSheet.Protect Password:="kode" 'låser pakkeinstruktionsarket igen
   
   
    Sheets("startside").Activate ' aktiverer startsiden igen
   
    End If
       
 

      ActiveSheet.Protect Password:="kode" ' skrivebeskytter startsiden igen
      Unload UserForm1
     
               
End Sub


Rem Aktiveres med Annullerknappen
Private Sub CommandButton2_Click()
ActiveSheet.Protect Password:="kode" ' skrivebeskytter
Unload UserForm1  ' lukker promptboxen ned
End Sub



Det er vist lidt rodet. Bare spørg ;O)

LN