'Het subscript valt buiten het bereik'

[Robjuh20]

Beste HelpMij'ers,

Ik heb een probleem. Ik probeer onderstaande macro uit te voeren, maar ik krijg iedere keer de foutmelding 'Het subscript valt buiten het bereik' (deze foutmelding krijg ik op het rode gedeelte van de macro). Ik heb deze macro via opname, maar hij doet het niet. Wat hij eigenlijk moet doen, is alle tabbladen selecteren, dan alle cellen en dan find en replace. Zie hieronder de code. Alvast bedankt!

Sub Knop4_Klikken()

    'Kopieren van de bestanden
    FileCopy "H:\Bestelbon naar factuur\Prijsfacturatie\_SJABLOON (prijs).xlsm", "H:\Bestelbon naar factuur\Prijsfacturatie\" & Range("E5").Value & " (prijs).xlsm"
    FileCopy "H:\Bestelbon naar factuur\Klantfacturatie\_SJABLOON.xlsx", "H:\Bestelbon naar factuur\Klantfacturatie\" & Range("E5").Value & ".xlsx"
    
    'Openen van het bestand in de map 'Klantfacturatie'
    Workbooks.Open ("H:\Bestelbon naar factuur\Klantfacturatie\" & Range("E5").Value & ".xlsx")
    ThisWorkbook.Activate
    
    'Selecteren van alle tabbladen
    Sheets(Array("Week 1", "Week 2", "Factuur W1+2", "Week 3", "Week 4", "Factuur W3+4", _
        "Week 5", "Week 6", "Factuur W5+6", "Week 7", "Week 8", "Factuur W7+8", "Week 9", _
        "Week 10", "Factuur W9+10", "Week 11", "Week 12", "Factuur W11+12", "Week 13", _
        "Week 14", "Factuur W13+14", "Week 15", "Week 16", "Factuur W15+16", "Week 17", _
        "Week 18", "Factuur W17+18", "Week 19", "Week 20", "Factuur W19+20", _
        "Week 21", "Week 22", "Factuur W21+22", "Week 23", "Week 24", "Factuur W23+24", _
        "Week 25", "Week 26", "Factuur W25+26", "Week 27", "Week 28", "Factuur W27+28", _
        "Week 29", "Week 30", "Factuur W29+30", "Week 31", "Week 32", "Factuur W31+32", _
        "Week 33", "Week 34", "Factuur W33+34", "Week 35", "Week 36", "Factuur W35+36", "Week 37", _
        "Week 38", "Factuur W37+38", "Week 39", "Week 40", "Factuur W39+40", "Week 41", _
        "Week 42", "Factuur W41+42", "Week 43", "Week 44", "Factuur W43+44", "Week 45", _
        "Week 46", "Factuur W45+46", "Week 47", "Week 48", "Factuur W47+48", "Week 49", _
        "Week 50", "Factuur W49+50", "Week 51", "Week 52", "Factuur W51+52")).Select[/COLOR]
    Sheets("Week 1").Activate
    
    'Selecteren van alle cellen
    Cells.Select
    Range("B14").Activate
           
    'Cellen hernoemen naar nieuwe naam
    Cells.Replace What:="_SJABLOON", Replacement:=Range("E5").Value, LookAt:=xlPart, SearchOrder _
       :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub

 

[wampier]

Het beste is sowieso om dit soort scripts zelf netjes te herschrijven. Subscript out of range wordt in dit geval waarschijnlijk veroorzaakt omdat je te veel tekst in je opdracht hebt.

Overigens voert deze macro alleen de opdracht op het eerste sheet uit, of je ze nu selecteert of niet.

deze code vervangt in alle tabbladen _sjabloon met E5 van dat blad.

Sub t2()
    For Each blad In Sheets
        blad.Cells.Replace What:="_SJABLOON", Replacement:=Range("E5").Value, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next blad
End Sub

 

[Robjuh20]

Dus als ik het goed begrijp, moet dit nu de code worden:

Sub Knop4_Klikken()

    'Kopieren van de bestanden
    FileCopy "H:\Bestelbon naar factuur\Prijsfacturatie\_SJABLOON (prijs).xlsm", "H:\Bestelbon naar factuur\Prijsfacturatie\" & Range("E5").Value & " (prijs).xlsm"
    FileCopy "H:\Bestelbon naar factuur\Klantfacturatie\_SJABLOON.xlsx", "H:\Bestelbon naar factuur\Klantfacturatie\" & Range("E5").Value & ".xlsx"
    
    'Openen van het bestand in de map 'Klantfacturatie'
    Workbooks.Open ("H:\Bestelbon naar factuur\Klantfacturatie\" & Range("E5").Value & ".xlsx")
    ThisWorkbook.Activate
    
    For Each blad In Sheets
        blad.Cells.Replace What:="_SJABLOON", Replacement:=Range("E5").Value, LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next blad
        
End Sub

Maar nu doet hij het nog steeds niet. Die E5 moet van het blad gehaald worden waarin gewerkt worden. De vervanging wordt gedaan in het zojuist gekopieerde bestand. Klopt dit dan nog?

 

[wampier]

Als de macro loopt in _sjabloon.xlsm dan werkt het niet, want:

thisworkbook.activate is op dat moment je nieuwe file. Als je het onderste deel van de macro met de hand op de nieuwe file laat lopen, werkt het dan wel goed?

 

[Robjuh20]

Deze macro loopt in een bestand genaamd 'Debiteuren'. In dit bestand heb ik een knop aangemaakt waar deze macro onderhangt. In dit bestand staat ook de E5. Die bladen die doorgelopen moeten worden, zitten in het bestand dat op dat moment aangemaakt is en geopend. Komt het dan door ThisWorkbook, dat hij het verkeerde bestand gaat doorzoeken?

 

[wampier]

Je kunt proberen

For Each blad In Activeworkbook.Sheets

Als je de code handmatig in in je nieuwe file stopt werkt het dan wel? dan kunnen we in ieder geval uitsluiten dat we geen vergissing hebben in de uitvoering.

 

[Robjuh20]

Alleen het For Each gedeelte los in het bestand, doet het wel. Dus er zit ergens iets fout met de link nog?

 

[wampier]

Ik heb het even getest, maar als ik:

Sub t2()
    Workbooks.Open ("test.xlsx")
    For Each blad In ActiveWorkbook.Sheets
        blad.Cells.Replace "erik", "todo"
    Next blad

End Sub

gebruik dat worden netjes alle "erik"s vervangen door "todo" in de nieuw geopende file

 

[Robjuh20]

Kan het zijn omdat er meer in de cel staat dan alleen maar _SJABLOON, dat ik nog iets extra moet toevoegen?

 

[snb]

Zelfs dit is genoeg:

Sub snb()
    For Each sh In Workbooks.Open("G:\OF\adressen.xls").Sheets
       sh.Cells.Replace "_sjabloon", sh.cells(5,5).value
    Next
    ActiveWorkbook.Close True
End Sub

 

[Robjuh20]

Het is gelukt! Super bedankt! Ik heb uiteindelijk deze code toegevoegd:

Sub Knop4_Klikken()

    'Kopieren van de bestanden
    FileCopy "H:\Bestelbon naar factuur\Prijsfacturatie\_SJABLOON (prijs).xlsm", "H:\Bestelbon naar factuur\Prijsfacturatie\" & Range("E5").Value & " (prijs).xlsm"
    FileCopy "H:\Bestelbon naar factuur\Klantfacturatie\_SJABLOON.xlsx", "H:\Bestelbon naar factuur\Klantfacturatie\" & Range("E5").Value & ".xlsx"
    
    Naam = Range("E5").Value
    Pad = "H:\Bestelbon naar factuur\Klantfacturatie\" & Range("E5").Value & ".xlsx"
    
    'Openen van het bestand in de map 'Klantfacturatie' + alles vervangen
     For Each sh In Workbooks.Open(Pad).Sheets
       sh.Cells.Replace "_SJABLOON", Naam
    Next
    ActiveWorkbook.Close True

        
End Sub