Opgelost Loopt niet door alle werkbladen

[DeArie]

Ik wil graag dat volgende code door alle werkbladen loopt, nu heb ik daar al diverse dingen voor gevonden en geprobeerd.
Maar of hij doet niets (zichtbaars) of hij zet 40 keer ( zoveel bladen staan er open ) onder elkaar op 1 blad.

Kan wil iemand mij dit uitleggen waarom?

Onderstaand de code welke door alle bladen moet lopen.

Sub Energietoeslag()
'
' Piektoeslag Macro

 
    Range("C" & Rows.Count).End(xlUp).Offset(1).EntireRow.Insert Shift:=xlDown

    x = [C2000].End(xlUp).Offset(1).Row
    y = Application.SumIf(Range([C10], Cells(x, 3)), "*pakket*", Range([D10], Cells(x, 4)))
    With Cells(x, 4).Resize(, 8).Borders(xlEdgeTop)
 
    End With
    Cells(x, 3) = "Energietoeslag pakketten"
    Cells(x, 4) = y
 

    Cells(x, 8).FillDown
   
    Cells(x, 10).FillDown
     
    Cells(x, 6).FormulaR1C1 = "0.08"
   
    Dim rng As Range
        Set rng = Range("A" & Rows.Count).End(xlUp).Offset(1)
        rng.Formula = "=""week "" & WEEKNUM(R4C2,2)"
        rng.Value = rng.Value
        rng.HorizontalAlignment = xlCenter
 
End Sub

Heb via Microsoft het volgende gevonden en aangepast

Sub WorksheetLoop()

         Dim WS_Count As Integer
         Dim I As Integer

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To WS_Count

            ' Insert your code here.
            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
           '' MsgBox ActiveWorkbook.Worksheets(I).Name
            Energietoeslag
         Next I

      End Sub

Maar zoals al geschreven zet hij dan alles op 1 blad onder elkaar ipv elk blad afzonderlijk.
Waar gaat dit mis?

En ik zou graag dit zo ver aanpassen dat hij ook eerst kijkt of er in kolom C het woord Pakket of brievenbuspakket staat.
Hoe kan ik dat het beste doen?

 

[OctaFish]

Activeer je het betreffende werkblad wel in de code? Je eerste code werkt op de actieve cel. Dat moet je dus dan wél aanpassen .
Bijvoorbeeld door de loop te baseren op worksheets.

Dim ws As Worksheet
For Each ws in ActiveWorkbook.Worksheets

En dan verder met je lus.

 

[emields]

bedoel je zoiets?

 

[AHulpje]

Probeer het hier eens mee.

 

[huijb]

Ik krijg een melding dat het bestand namen van personen en bedrijven bevat, Daarom bestanden verwijderd.

 

[DeArie]

Het bestand is aangepast, heb het ondertussen ook al voor elkaar dat hij alle bladen langs loopt.
Het volgende wat ik nu Graag zou zien is dat hij eerst controleert of het woord "pakket" in kolom C staat en dan pas de code uitvoert en anders doorgaat naar het volgende blad

@AHulpje @emields helaas zie ik jullie reactie niet helemaal ( waarschijnlijk doordat ik zo stom was namen in mijn bestand te zetten)
@OctaFish Heb wel geprobeerd met wat je aangaf maar kreeg dat ook niet werkende

Sub Energietoeslag()
'
' Energietoeslag Macro
    Application.ScreenUpdating = False

    Dim a As Integer

    a = Application.Worksheets.Count

    For I = 1 To a
    Worksheets(I).Activate

 
    range("C" & Rows.Count).End(xlUp).Offset(1).EntireRow.Insert Shift:=xlDown

    x = [C2000].End(xlUp).Offset(1).Row
    y = Application.SumIf(range([C10], Cells(x, 3)), "*pakket*", range([D10], Cells(x, 4)))
    With Cells(x, 4).Resize(, 8).Borders(xlEdgeTop)
 
    End With
    Cells(x, 3) = "Energietoeslag pakketten"
    Cells(x, 4) = y
  

    Cells(x, 8).FillDown
    
    Cells(x, 10).FillDown
      
    Cells(x, 6).FormulaR1C1 = "0.08"
    
    Dim rng As range
        Set rng = range("A" & Rows.Count).End(xlUp).Offset(1)
        rng.Formula = "=""week "" & WEEKNUM(R4C2,2)"
        rng.Value = rng.Value
        rng.HorizontalAlignment = xlCenter
 
 Next
End Sub

 

[snb]

Als je met Excel wil werken, gebruik dan de ingebouwde voorzieningen van Excel: dynamische tabel, draaitabel.
Dan heb je geen enkele VBA-code nodig.
Gebruik Excel niet als een kaartenbak.
En gebruik nooit samengevoegde cellen (wat altijd duidt op 'papierdenken').

 

[AHulpje]

Probeer het zo eens:

Sub Energietoeslag()
' Energietoeslag Macro
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        ws.Activate
        If Not Cells.Find(What:="pakket") Is Nothing Then
            Range("C" & Rows.Count).End(xlUp).Offset(1).EntireRow.Insert Shift:=xlDown
    
            x = [C2000].End(xlUp).Offset(1).Row
            y = Application.SumIf(Range([C10], Cells(x, 3)), "*pakket*", Range([D10], Cells(x, 4)))
            With Cells(x, 4).Resize(, 8).Borders(xlEdgeTop)
     
            End With
            Cells(x, 3) = "Energietoeslag pakketten"
            Cells(x, 4) = y
            Cells(x, 8).FillDown
            Cells(x, 10).FillDown
            Cells(x, 6).FormulaR1C1 = "0.08"
        
            Dim rng As Range
            Set rng = Range("A" & Rows.Count).End(xlUp).Offset(1)
            rng.Formula = "=""week "" & WEEKNUM(R4C2,2)"
            rng.Value = rng.Value
            rng.HorizontalAlignment = xlCenter
        End If
    Next
End Sub

 

[DeArie]

@AHulpje dit werkt perfect, dankjewel!
@snb kan ze niet zo gebruiken zoals jij aangeeft het betreft specificaties voor facturen. Vandaar dat het zoveel tabbladen zijn.

Iedereen weer bedankt.

 

[snb]

Wat je zegt klopt niet.