Cellen kopiëren en versturen als e-mail

[Dennis223]

Beste,

VBA vind ik ontzettend leuk om uit te vogelen hoe formules in elkaar steken, alleen het onderstaande kom ik echt niet uit:

Het volgende zou de macro moeten doen:

Elke ochtend verstuur ik vanuit het Excel-bestand informatie via de mail. Dit doe ik op dit moment nog ouderwets door het kopiëren en plakken van de data uit de geselecteerde cellen naar Outlook. Maar met een VBA zou dit natuurlijk binnen twee tellen gepiept moeten zijn.




De bedoeling is om de macro als eerste in kolom C ("C:C") te laten zoeken naar alle letters G, F en S.
Als hij door de sheet heeft gezocht, moet hij de namen (kolom A) die gekoppeld zijn aan de letters G, F en S in kolom C, alsmede de waarden die de cellen hebben in kolom CW, kopiëren en er een e-mail van genereren. Aangezien kolom CW gekoppeld is aan een dag en deze kolom dus elke dag opschuift, is het wellicht makkelijker als ik de kolom (de dag) selecteer waarvan ik de bovengenoemde info wil mailen.

Hopelijk is het een beetje duidelijk en kan iemand mij op weg helpen met de code!!

Alvast ontzettend bedankt

 

[VenA]

Mij lijkt een excelbestand wat handiger dan plaatjes.

 

[Dennis223]

Staan zaken in die niet voor iedereen bestemd is haha

 

[VenA]

Haal je het er toch uit en vervang je het door fictieve data haha

 

[cow18]

Ok

 

[gast0660]

Ik vind het verkeerd van alle helpers, als de TSers te lui zijn om een voorbeeld bestandje te maken dat er nog hulp wordt geboden.
(als een voorbeeld van belang is natuurlijk)

 

[Dennis223]

Hopelijk is het in dit bestand redelijk duidelijk wat ik wil

 

[HSV]

Sub hsv()
Dim rRng As Range, sv, s0 As String, i As Long
With Sheets("blad1")
  With .Cells(1).CurrentRegion.Resize(, .Cells(1, Columns.Count).End(xlToLeft).Column)
     .AutoFilter 3, Array("F", "G", "S"), 7
     Sheets("blad2").Cells(1).CurrentRegion.Clear
     Union(.Columns(1), .Columns(2), .Columns(.Cells(1, Columns.Count).End(xlToLeft).Column)).Copy Sheets("blad2").Cells(1)
     .AutoFilter
  End With
End With
sv = Sheets("blad2").Cells(1).CurrentRegion
   For i = 2 To UBound(sv)
     s0 = s0 & "<tr><td>" & Join(Application.Index(sv, i), "</td><td>") & "</td></tr>"
   Next
With CreateObject("Outlook.Application").createitem(0)
          .To = "zomaar@gmail.com"
          .Subject = "test"
          .htmlbody = "<table border=1 bgcolor=FFFFFF>" & s0 & "</table"
          .display
          '.send
        End With
End Sub

 

[VenA]

Zonder tussenkomst van een extra blad lijkt ook te werken.

Sub VenA()
  ar = Sheets("Blad1").Cells(1).CurrentRegion.Resize(, Sheets("Blad1").Cells(1, Columns.Count).End(xlToLeft).Column)
  For j = 2 To UBound(ar)
    If InStr(1, "fgs", ar(j, 3), vbTextCompare) Then
      c00 = c00 & "<tr><td>" & ar(j, 1) & "</td><td>" & ar(j, 2) & "</td><td>" & ar(j, UBound(ar, 2))
    End If
  Next j
  With CreateObject("Outlook.Application").createitem(0)
    .To = "zomaar@gmail.com"
    .Subject = "test"
    .htmlbody = "<table border=1 bgcolor=FFFFFF>" & c00 & "</table"
    .display '.send
  End With
End Sub

 

[HSV]

Netjes @VenA,

Ik zat er over na te denken, maar kreeg niet meer tijd van vrouw, kinderen en schoonzoons.

Nog een variant zonder lusje.

Sub hsv()
Blad1.Cells(1).CurrentRegion.Columns(Blad1.Cells(1, Columns.Count).End(xlToLeft).Column).Name = "a"
Blad1.Cells(1).CurrentRegion.Columns(1).Name = "b"
s0 = Join(Filter([transpose(if((offset(b,,2)="f")+(offset(b,,2)="g")+(offset(b,,2)="s"),"<tr><td>"&b&"</td><td>"&offset(b,,1)&"</td><td>"&a,"~"))], "~", False))
   With CreateObject("Outlook.Application").createitem(0)
          .To = "zomaar@gmail.com"
          .Subject = "test"
          .htmlbody = "<table border=1 bgcolor=FFFFFF>" & s0 & "</table"
          .display '.send
        End With
End Sub

 

[Dennis223]

Heren!

Dank voor de code(s)! Alleen werkt hij niet lekker in het eigenlijke bestand:

Hij maakt keurig een e-mail aan, maar vervolgens krijg ik een blanco tabel te zien zonder data.. Welke dingen doe ik verkeerd?
De 6e kolom is elke dag anders. Het is niet constant kolom F, maar de huidige dag is de 6e kolom (alle dagen voorafgaand verbergen we in de file).

 

[VenA]

De 6e kolom is altijd kolom F. Alle codes gaan uit van de laatste zichtbare kolom. Waarom het bij jou niet werkt dat weet ik niet.