sheet opslaan

[ridan]

Hoi allemaal,

Ik heb een probleempje met het opslaan van een bestand
Een klein beetje uitleg :
Voordat ik een workbook sluit moet er een sheet(Dagrapport) gekopiëerd worden en geplakt in een ander bestand("D:\bundel\dagrapport.xls")
Dit bestand bestaat uit 3 sheets" Dienst 1,Dienst 2,Dienst 3"
Na lang zoeken heb ik de volgende code aangemaakt,maar ... ze werkt niet.Kan iemand mij helpen AUB?
Niet te moeilijk maken hé mannen,vrouwen, want ik heb niet zo veel verstand van VB.
Dank bij voorbaat

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Range("a56") = 1 Then GoTo 1:
If Range("a56") = 2 Then GoTo 2:
If Range("a56") = 3 Then GoTo 3:
     
1:
  Application.ScreenUpdating = False
 Worksheets("Dagrapport").Range("A2:p270").Copy
   
    Workbooks.Open Filename:="D:\bundel\dagrapport.xls"
        Workbooks("dagrapport").Worksheets("Dienst 1").Range("a2").Select
     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    Application.CutCopyMode = False
    
    
    ActiveWorkbook.Save
    ActiveWindow.Close
   
    Sheets("Navigatie").Select
    Range("A1").Select
  Application.ScreenUpdating = True
  
  GoTo einde
  
2:
 Application.ScreenUpdating = False
Worksheets("Dagrapport").Range("A2:p270").Copy
   
     Workbooks.Open Filename:="D:\bundel\dagrapport.xls"
 ActiveSheet.Paste Destination:=Worksheets("Dienst 2").Range("a2")
    
    
     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    
    Application.CutCopyMode = False
   
    
    ActiveWorkbook.Save
    ActiveWindow.Close
   
    Sheets("Navigatie").Select
    Range("A1").Select
   Application.ScreenUpdating = True
  
 GoTo einde
 
3:
 Application.ScreenUpdating = False
 Worksheets("Dagrapport").Range("A2:p270").Copy
   
     Workbooks.Open Filename:="D:\bundel\dagrapport.xls"
    
    Workbooks("dagrapport").Worksheets("Dienst 3").Select
     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
   
    
    Application.CutCopyMode = False
    
    ActiveWorkbook.Save
    ActiveWindow.Close
   
    Sheets("Navigatie").Select
    Range("A1").Select
  
  Application.ScreenUpdating = True
  GoTo einde

einde:
  ActiveWorkbook.Save
End Sub

 

[Ginger]

Ridan, Ik heb je code wat opgeschoond. Probeer met programmeren de 'GoTo' te vermijden. Dit wordt op een gegeven moment volkomen onleesbaar. Verder heb ik je verschillende sheetnamen in een 'Select Case' gedaan. Daarmee hoef je dus ook niet meer 3x dezelfde codeblokjes in 1 code te stoppen.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sDienst As String
     
    Application.ScreenUpdating = False
    
    Select Case Range("A56").Value
        Case 1
            sDienst = 1
        Case 2
            sDienst = 2
        Case 3
            sDienst = 3
    End Select
    
    sDienst = "Dienst " & sDienst 'dit is nu de naam van je sheettab
      
    Workbooks.Open Filename:="D:\bundel\dagrapport.xls"
    
    Workbooks("[COLOR="Blue"][hier de naam van je 1e workbook][/COLOR]").Worksheets("Dagrapport").Range("A2:p270").Copy
       
    Workbooks("dagrapport").Worksheets(sDienst).Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        
    Application.CutCopyMode = False
        
    ActiveWorkbook.Close savechanges:=True 'als het goed is, is dit D:\bundel\dagrapport.xls
       
    Sheets("Navigatie").Range("A1").Select
    
    Application.ScreenUpdating = True
      
    ActiveWorkbook.Save
    
End Sub

Geef verder trouwens ff goed aan WAT er dan niet werkt. Met alleen maar een 'het werkt niet' komen we niet verder.

Groet, Leo

 

[ridan]

Goeie morgen allemaal

Ginger heeft voor mij de oplossing.

Dus bedankt Ginger,en hierbij is de vraag opgelost