Loop through sheets with Call macro's

[Melanie1987]

Hello,

I'm trying to make this code work for all my sheets.
But after trying for several hours I give up.
The problem seems to be that the code doesn't loop through the sheets.

Sub NaDataInvoegen()


 Application.ScreenUpdating = False
 
Call VerwijderMonstervoorbewerking1
Call VerwijderOpwerkingMineralen
Call TekstNaarGetal
Call ReplaceTitle
Call CreateSheet
Call CellenUitlijnenenFilter








  Application.ScreenUpdating = True


End Sub
Sub VerwijderMonstervoorbewerking1()


Dim i As Long




lst = Range("G" & Rows.Count).End(xlUp).Row




For i = lst To 2 Step -1




    If Range("G" & i).Value Like "*Monstervoorbewerking*" Then
        
        Range("G" & i).EntireRow.Delete
        
    End If




Next i


 


End Sub


Sub VerwijderOpwerkingMineralen()


Dim i As Long




lst = Range("G" & Rows.Count).End(xlUp).Row




For i = lst To 2 Step -1




    If Range("G" & i).Value Like "*Opwerking mineralen*" Then
        
        Range("G" & i).EntireRow.Delete
        
    End If




Next i


 


End Sub


Sub TekstNaarGetal()


  Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), DecimalSeparator:=".", ThousandsSeparator:=" ", _
        TrailingMinusNumbers:=True
         ActiveCell.Select








End Sub








Sub ReplaceTitle()
    Columns("K").Replace What:="Geëvaporeerde / geconcentreerde melk", _
                            Replacement:="Geëvap_geconcentreerde melk", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=False
                            
End Sub


Sub CreateSheet()
    
    Dim bottomA As Long
    bottomK = Sheets("data").Range("K" & Rows.Count).End(xlUp).Row
    Dim Rng As Range
    Dim WS As Worksheet
    Dim rngUniques As Range
    Sheets("data").Range("K1:K" & bottomK).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("K1:K" & bottomK), Unique:=True
    Set rngUniques = Sheets("data").Range("K2:K" & bottomK).SpecialCells(xlCellTypeVisible)
    If Sheets("data").AutoFilterMode = True Then Sheets("data").AutoFilterMode = False
    For Each Rng In rngUniques
        Set WS = Nothing
        On Error Resume Next
        Set WS = Worksheets(Rng.Value)
        On Error GoTo 0
        If WS Is Nothing Then
            Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Rng.Value
            Sheets("data").Rows(1).Copy Cells(1, 1)
        End If
    Next Rng
    For Each Rng In rngUniques
        Sheets(Rng.Value).UsedRange.Offset(1, 0).ClearContents
        Sheets("data").Range("K1:K" & bottomK).AutoFilter Field:=1, Criteria1:=Rng
        Sheets("data").Range("K2:K" & bottomK).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(Rng.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Sheets("data").AutoFilterMode = True Then Sheets("data").AutoFilterMode = False
        
 
        
    Next Rng
    


Sheets("data").Select


 End Sub


Sub CellenUitlijnenenFilter()






Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets




    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    Selection.AutoFilter
   




Next WS


Sheets("data").Select


End Sub

I'm hoping somebody can help me.

 

[Melanie1987]

note: All the macro's seem to work for me except the Sub CellenUitlijnenenFilter()

 

[Peter_SSs]

note: All the macro's seem to work for me except the Sub CellenUitlijnenenFilter()

I haven't looked right through your codes and I suspect this wouldn't be the best overall solution, but does adding this line of code in Sub CellenUitlijnenenFilter() resolve the immediate issue?

For Each WS In ThisWorkbook.Worksheets

    WS.Activate
    
    Cells.Select

 

[Melanie1987]

Thank you so much.

It works as a charm.

 

[Peter_SSs]

Thank you so much.

It works as a charm.

Good news.
The issue is that you cannot select a range on a sheet that is not the Active Sheet.

Having said that, it is rare that you have to select a range to work with it in vba and selecting can slow your code considerably, as well as causing a lot of screen flickering. So try to learn about writing code that does not require you to actually 'select' anything.

 

[Kamolga]

Happy it works and if your file keeps on running at normal speed, do not pay too much attention to what is below but keep it somewhere in your head.

Simply note that if you plan to have many sheets and/or many lines in the future, you will need to be more specific: applying a format on all cells, filter on full rows can multiply dramatically the size of a file (and make it so slow you have to rework it completely).

An easy way to avoid that is to put the data on each sheet in a table, you then select each table on each sheet (so only cells with data, a table extend automatically if you add data) to handle the column width and set filters.
Doing so, you don't "tell Excell" to store a format on millions of empty cells basically.