Macro voor het opslaan van bestand m.b.v. macro

[PD2009]

Aan allen,

Ik heb een Excel bestand met daarin diverse kolommen. Alle kolommen
bevatten een autofilter.
In kolom A worden verschillende scholen en instellingen in gevoerd,
in kolom B de naam van de mentor en
in kolom C het e-mail adres van de mentor.
Kolom D en verder bevatten n.a.w. en andere gegevens.
Het aantal rijen bedraagt 500 of meer en het aantal verschillende
scholen of instellingen 30 of meer.


Nu moeten voor de verantwoording iedere school een overzicht sturen
van alle clienten die onder de menter van de betreffende school
vallen. (een op een relatie, een school, een mentor)


Tot op heden doen we dat door het gebruik van het autofilter in kolom
A. Dus we openen het autofiler in kolom A kiezen de eerste school die
voorkomt, slaan de selectie op onder de naam van de school en het
weeknummer. Dit herhalen we dus 30 keer (of net zo vaal als het aantal
scholen in het autofilter. Daarna moeten de 30 bestanden nog gemaild
worden aan de betreffende mentoren


Nu zou ik graag deze handelingen geautomatiseerd willen hebben via een
macro die het autofilter afloopt en alle voorkomende scholen en
instellingen een voor een in een bestand opslaat met bijvoorkeur de
naam van de school en het weeknummer (bepaald in cel A1.) en als dat
ook nog tot de mogelijkheden behoort vervolgens het e-mail adres uit
kolom C gebruikt om het bestand klaar te zetten in Outlook en of
direct door te mailen


De registratie begint vanaf cel A3, een voorbeeld van het bestand is bijgesloten.


Heeft iemand hier een oplossing voor of kan mij op weg helpen.


Met vriendelijke groeten
Frans Schilder

 

[snb]

Is dit een forumvraag of een automatiseringsopdracht ?

Sub tst()
  c0 = [transport!A1]
  If VarType(c0) = 10 Then
    With Sheets.Add
      .Name = "transport"
    End With
  End If
  Columns(27).ClearContents
  Columns(1).SpecialCells(2).AdvancedFilter xlFilterCopy, , [AA1], True
  sq = Cells(1, 27).CurrentRegion.Offset(1)
  For j = 1 To UBound(sq)
    Sheets("transport").Cells.ClearContents
    With [A1].CurrentRegion
      .AutoFilter 1, sq(j, 1)
      .SpecialCells(xlCellTypeVisible).Copy [transport!A1]
      .AutoFilter
    End With
    Sheets("transport").Copy
    With ActiveWorkbook
      .SendMail [transport!C2]
      .Close False
    End With
  Next
End Sub

 

[PD2009]

Snb

Bedankt voor je antwoordt met name de oplossing voor de loop is perfect.

Met vriendelijke groeten
Frans