Algoritme loopt en breekt vroegtijdig af

[bertkt]

Hallo,

Ik wil van elk tabblad een apart bestand maken.
Het bijgevoegde bestandje heb ik aangepast zodat het bij iedereen (normaal gezien) werkt.

Het probleem is dat hij (bij mij) van de eerste 7 tabladen perfect 7 aparte bestanden maakt,
maar dan bij het 8ste tabblad heeft hij een foutmelding bij "ws.copy"... nogtans had ie 't al 7 keer goed eerder gedaan!?!!

Is er iets fout met het klembord? Ik weet het niet meer.

ALVAST BEDANKT

Sub loopSheetsTOS()  'Tabbladen opslaan als

    Application.ScreenUpdating = False

    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        
        If Left(ws.Name, 2) = "R1" Then
        
            ws.Select
            Call tabbladOpslaanAls(ws)
            Range("A1").Select
            
        End If
    Next ws
    
    Application.ScreenUpdating = True
    
End Sub

Sub tabbladOpslaanAls(ByVal ws As Worksheet)
    Dim strMPad As String
    Dim strPad As String
    Dim strName As String
    Dim strFileName As String
        
        strMPad = ThisWorkbook.Path
        strPad = strMPad '               & "\Kasten"
        
        strName = ActiveSheet.Name
        
        strFileName = strName & ".xls"
        [I][B][U]ws.Copy[/U][/B][/I]
        ChDir strPad     
        If CInt(Application.Version) <= 11 Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=strFileName
            Application.DisplayAlerts = True
        Else
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=strFileName, FileFormat:=xlExcel8
            Application.DisplayAlerts = True
        End If
    
        ActiveWorkbook.Close
    Set ws = ActiveSheet
End Sub

 

[snb]

waarom niet:

Sub M_snb()
    Application.ScreenUpdating = False

    For Each sh In sheets
        If Left(sh.Name, 2) = "R1" Then
           sh.copy
           activeworkbook.saveas "G:\OF\" & sh.name & ".xls"
           activeworkbook.close false
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub

assumptie : je werkt met Excel 2003 of eerder.

 

[bertkt]

Hallo,

Aan het volgende ben ik gebonden:
Ik ben verplicht om met een relatief pad te werken, omdat het bestand uiteindelijk naar de klant zal gaan.
De klant wenst een xls bestand.

Vandaar dus dat ik het absolute pad niet neem.

- Bert

 

[snb]

Ja, en ?

 

[Warme bakkertje]

@ snb
Ge laat ze toch graag boven de afgrond bengelen hé

@ Bert,
Hier was toch geen universiteitsopleiding voor nodig om deze uit te vogelen, nietwaar ?

Sub M_snb()
    Application.ScreenUpdating = False
    For Each sh In Sheets
        If Left(sh.Name, 2) = "R1" Then
           sh.Copy
           ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sh.Name & ".xls"
           ActiveWorkbook.Close False
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[bertkt]

Zelfs met de nieuwe code lukt het nog niet, hetzelfde probleem blijft.
Na altijd opnieuw de eerste 7 bestanden correct te hebben "exporteert" heeft hij de foutmelding.
Ter illustratie:
-
-

Ik heb het geprobeerd vanop de netwerk harde schijf, rechtstreeks onder de C-schijf, en ook vanop een USB stick... telkens weer opnieuw de eerste 7 bestanden die correct geëxporteerd zijn.

Bij de foutopspring heeft ie de fout bij sh.copy.

Wat zou dit probleem kunnen zijn?
Of hoe zou ik het kunnen omzeilen?

 

[Warme bakkertje]

Plaats dat 8ste blad dan eens helemaal achteraan en kijk dan eens wat de code doet.

 

[snb]

Het is wel handig als alle werkbladen zichtbaar zijn.....

 

[bertkt]

Een stapje verder ben ik... Het ligt aan mijn tabblad zelf.

Ik nam bvb tabblad R1EAC10GT100, ik plaatste het vooraan en liet VBA lopen.
Onmiddellijk gaf hij al de fout.
Dat zogenaamde tabblad bestaat uit twee rijen: de kolomtitels + 1 rij data... daarop faalt hij.

Dus blijkbaar kan hij geen "ws.copy" doen van een tabel met twee rijen... wat ik wel wat raar vind...
Suggesties?