waarden tabbladen optellen

[Delee]

zie ook:
http://www.helpmij.nl/forum/showthread.php?t=384854

Zeer gewaardeerd forum! :thumb:

IK zoek een -bruikbare - oplossing voor het volgende:
Op tabblad 1 heb ik een lijst met namen.
Op tabblad 2 komen de totalen van de tabbladen 3-x.
Op tabbladen 3-x staan waardes in cellen die op tabblad 2 opgeteld moeten worden. De tabbladen 3-x corresponderen met de lijst op tabblad 1.

Bijgaand mijn huiswerk:
Een timesheet.xls waarin de medewerkers hun tijd in moeten registreren. Deze heeft een knop waardoor het tabblad wordt gesaved naar een bepaalde directory.
Het weektotaal.xls die deze directory uitleest. Let hierin op de macro Weektotaal_bijvullen().

"Puzzelen is leuk maar het moet je geen nachtrust kosten"

Met vriendelijke groet, Leo

 

[Warme bakkertje]

Leo, problemen met het openen van je files. Denk ondertussen een oplossing te hebben voor je probleem van wisselend aantal sheets. Kijk op volgende link in de laatste alinea

http://www.ozgrid.com/Excel/Sum.htm

Laat iets horen of dit van toepassing is, anders zoeken we verder

Mvg

Rudi

 

[Delee]

Uniek! Top! Hij doet het! :thumb:
Heb ik nu wel weer een uitdaging om de tussenliggende tabbladen te verwijderen via VBA (had ik toch al).

Doet het niet (goed):

Sub Verwijder_Sheets()
Dim MyArray() As Integer
Dim i As Integer, sc As Integer

If MsgBox("Wil je de sheets verwijderen?", vbYesNo, "Let op!") = vbNo Then Exit Sub
Application.ScreenUpdating = False

sc = Sheets.Count
For i = 1 To sc

Sheets(Array(i + 2)).Delete
Next i

Application.ScreenUpdating = True

End Sub

Kan jij een tipje van de sluier op lichten?

In ieder geval bedankt voor je oplossing (hele zaterdag gekost, de hond is verwaarloosd )

Groet,leo

 

[Warme bakkertje]

Leo, probeer volgende eens.

Sub Verwijder_Sheets()
    Dim ws As Worksheet
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
         
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> "Weektotaal" Then ws.Delete
        Next ws
         
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Leo, kan je je vorige vraag nog even op opgelost zetten aub

Mvg

Rudi

 

[Delee]

Hoi Rudi,
Je kan geen meerdere tabbladen opgeven achter:
If ws.Name <> "Weektotaal" or "Gegevens" or "Eerste" or "Laatste" Then ws.Delete ???
Met name de eerste en laatste...daar was ik net zo blij mee...
Greot,
Leo

 

[Warme bakkertje]

Leo, eentje met userform waarin je blad per blad kunt selecteren en verwijderen.

Mvg

Rudi

 

[Delee]

Hoi Rudi,
Je hebt me in ieder op het goede spoor gezet!
Ik heb er het volgende van gemaakt:

Sub Verwijder_Sheets()
Dim ws As Worksheet
With Application
.DisplayAlerts = False
.ScreenUpdating = False

Worksheets("Weektotaal").Activate
Range("a200").Value = "x"

Worksheets("Gegevens").Activate
Range("a200").Value = "x"

Worksheets("Eerste").Activate
Range("a200").Value = "x"

Worksheets("Laatste").Activate
Range("a200").Value = "x"

For Each ws In ActiveWorkbook.Worksheets
If ws.Range("a200") = 0 Then ws.Delete
Next ws

.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

Dank voor je hulp. :thumb: Ik zal de thread op "opgelost" zetten.
Tot ziens op het forum!

Groet,
Leo

 

[Warme bakkertje]

Leo, voor de snelheid van uitvoering kan je je macro nog als volgt wijzigen.

Sub Verwijder_Sheets1()
Dim ws As Worksheet
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    
    Sheets(Array("Weektotaal", "Gegevens", "Eerste", "Laatste")).Select
    Sheets("Weektotaal").Range("A200").Activate
    ActiveCell.FormulaR1C1 = "x"

For Each ws In ActiveWorkbook.Worksheets
    If ws.Range("A200") = 0 Then ws.Delete
Next ws

    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

Suc6 verder en tot wederhoren

Mvg

Rudi