Brieven maken naar aanleiding van excelsheet

[HWV]

Beste,

Ik zit met het volgende ik heb een lijst met prijsafspraken die ik naar excel haal vanuit een ERP systeem.
Doormiddel van een macro wil ik die lijst bewerken zodat er uiteindelijk een brief uit komt die ik naar onze klant kan sturen.
Ok, dit is gelukt per klant.

Nu zie je in de bijlage dat ik in een bestand meerder klanten heb staan waar ik de brief per klant heen wil sturen.

Nu zou er moeten gekeken worden in kolom A naar het debiteurennummer.die voor elke regel staat. Is die het zelfde zo deze bijvoorbeeld naar een apparte worksheet getransporteerd moeten worden. daar de macro laten draaien (zoals in de bijlage) en deze dan opslaan onder naam en debiteurennummer.

In het tabblat critiria staat een voorbeeld van hoe het formulier er nu uit zie na bewerking van de macro in de bijlage.

Wat doet de macro.

Hij gooit de overtollige kolomen er uit
Zet het debiteurennummer bovenaan
Zorg dat er teksten boven en onder de artikelen komen te staan
Ga via een ander bestand de adres gegevens er bij zoeken.

En je krijg het uiteindelijke resultaat.

Kan iemand mij hiermee helpen zodat ik van alle klanten zo`n brief kan maken, en dat deze dan worden opgeslagen in een bepaalde map per klant.

Groet HWV

 

[HWV]

Stapje verder

Beste,

Ik ga natuurlijk ook verder maar loop vast.
Wat heb ik nu gedaan.
Ik heb uit de lijst de klant nummers gehaald en ontdubbeld.
Dan maakt hij van elke klant een tabblad aan met zijn nummer.
( zie module 2)

nu moet ik alleen nog het voor lekaar krijgen om de artikelen van die klant in de juiste map te krijgen.
Zorgen dat hij dan de macro over alle tabbladen draait
En dat deze dan per sheet opglagen gaan worden op de harde schijf

Kunnen jullie mij hiermee helpe , want ik loop hier vast mee

Alvast bedankt voor de aangboden hulp.

HWV

 

[popipipo]

http://www.helpmij.nl/forum/showthread.php?t=519939
Bekijk deze vraag eens met mijn antwoord.

PS het is directeur en niet diricteur.
(criteria cel A42)

 

[HWV]

Weer een stap verder de juiste richting op

@ popipipo goed opgemerkt "Directeur"

Zo dat gaat een stuk sneller zeg.
Zo kom ik al aardig dichter bij mijn doel.
De bestanden staan nu inderdaad allemaal netjes in de sheets waar ze horen met de debnr erbij.

Nu moet ik nog iets zien te vinden dat de macro op alle sheets zijn werk gaat doen en weg gaat zetten op de harde schijf.
Maar ik moet ik ook de macro`s daarvan aanpassen ivm dat ik de sheets naam daarin heb gebruikt :-(

Een stap verder, maar ik ben er nog niet

Groet HWV

 

[HWV]

Sub AlleSheetsFormulierMaken()
Dim sh As Object

    For Each sh In ThisWorkbook.Sheets
        If sh.Index > "" Then
            formule
        End If
    Next sh

End Sub

Ik gebruik deze code om mijn macro Formule aan te sturen.

Maar wat hij niet doet is naar het desbetreffende sheet gaan.
In bij code die hoort onder Formule gebruik ik nu

ActiveSheet.PageSetup

ActiveSheet

Hoe zorg ik dat ik ook werkelijk op de desbetreffende sheet komt te staan zodat ik op elke sheet zo`n bevestiging formulier kan krijgen

Groet HWV

 

[HWV]

De volgende code heb ik gebruikt :

- Maakt van elke debiteur in de lijst een sheet aan
- Kopieer de regels van de desbetreffende debiteur
- Maakt voor elke debiteur een bevestigingsbrief
- Slaat de sheetnaam (debiteurennummer) op op de harde schijf.

Sub SheetsMaken()

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Dim c As Range
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim sh As Object
    
    On Error Resume Next
    
    Sheets("Criteria").Delete
    
    Set ws1 = ThisWorkbook.Worksheets("Data1")
    
    For Each c In ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
        
        If WksExists(c.Text) Then
        
            Set ws = ThisWorkbook.Worksheets(c.Text)
            
        Else
        
            Set ws = ThisWorkbook.Worksheets.Add
            ws.Name = c.Text
        
        End If
        
        c.Resize(, 26).Copy ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
        
    Next

ws1.Select
ws1.Columns("aV:aX").Delete


    For Each sh In ThisWorkbook.Sheets
        If sh.Index > "" Then
                Sheets(sh.Name).Select
            formule 'roept de andere formule op
        End If
    Next sh

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
         
        Sheets(ws.Name).Select
        Sheets(ws.Name).Copy
        ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Henk\Desktop\Helpmij\Test\" & ws.Name & ".xls", _
        FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close
        ThisWorkbook.Activate
    Next

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Ik ben uit eindelijk bij mijn eindoel gekomen.
Ik wil een ieder bedanken voor zijn inzet met name popipipo die me de juiste richting heeft gestuurd om tot deze code te komen.

Groet HWV