2 of meerdere tabbladen versturen via e-mail.

[danny147]

Beste,

Graag zou ik 2 of meerdere tabbladen willen versturen via e-mail.
Deze 2 tabbladen bevatten formules !
Dus versturen als waarden.
De werkmap bevat 10 tabbladen.
Ik gebruik Microsoft Office Outlook.

Of een nieuwe map aanmaken met daarin de 2 tabbladen is ook goed, beide nog beter :d

Groetjes Danny. :thumb:

 

[ExcelAmateur]

danny147,

Heb je hier al gekeken?
Daar heb je dan weer een link naar http://www.rondebruin.nl/mail/folder1/mail3.htm

 

[danny147]

Beste ExcelAmateur

Heb de codes zien staan.

Wie kan er een code in elkaar steken waarvan tabblad 4 en 5 moet worden verzonden en alle e-mailadressen staan in Tabblad "E-mailadressen".

dus deze regel ertussen:

Dim MyArr As Variant
MyArr = ThisWorkbook.Sheets("E-mailadressen").Range("A1:A100")
.SendMail MyArr, "Lotto uitslagen"

Groetjes Danny. :thumb:

 

[danny147]

Beste,

Heb een opzetje proberen te maken maar het loopt niet goeg

Sub bladwegschrijven()
    Application.SheetsInNewWorkbook = 1
    With Workbooks.Add
        With .Sheets(1)
            ThisWorkbook.Sheets("Tussen-Eindklassement").Range("A1:T103").Copy.[A1]
            .Parent.SaveAs "C:\Users\asus\Documents\Werk\Tussen-Eindklassement" & ".xls"
        With .Sheets(1)
            ThisWorkbook.Sheets("Prijzenverdeling").Range("A1:D39").Copy.[A1]
            .Parent.SaveAs "C:\Users\asus\Documents\Werk\Prijzenverdeling" & ".xls"
        End With
        End With
        End With
End Sub

De bedoeling is dat ik tabblad Tussen-Eindklassement en tablad Prijzenverdeling apart als excelbestandje wil aanmaken in het pad: C:\Users\asus\Documents\Werk\
Maar hij neemt de formules ook over en dat mag niet.

Wie kan mij verder helpen ?

Groetjes Danny. :thumb:

 

[Ginger]

Danny, da's maf... Zit ik je hele draadje te lezen, wil ik reageren wat niet lukt, ga ik vervolgens even uit Helpmij en keer terug, zie ik dat je héle draadje is teruggebracht tot slechts je initiële vraag... Schiet mij maar lek...

Maar goed, om op je laatste verdwenen post in te haken, heb je hier alvast een klein blokje code om die 2 genoemde bladen te copieren en samen tot een nieuwe werkmap te maken.

Sub bladwegschrijven()
    
    Sheets(Array("Tussen-Eindklassement", "Prijzenverdeling")).Copy
    For Each sh In ActiveWorkbook.Sheets
        sh.Cells.SpecialCells(xlCellTypeFormulas).Value = sh.Cells.SpecialCells(xlCellTypeFormulas).Value
    Next sh
    ActiveWorkbook.SaveAs "C:\Users\asus\Documents\Werk\Tussen-Eindklassement" & Date & ".xls"
    
End Sub

Vervolgens worden op beide bladen de formules omgezet naar vaste waarden. Daarna nog even opslaan en klaar ben je...
Kan je hier iets mee?

Groet, Leo

 

[HSV]

Ik net als Leo, Danny.

Jouw voorbeeld leek op deze.
Heb een kleine aanpassing gedaan.

Misschien dat je het zo bedoeld.

Sub bladwegschrijven()
    Application.SheetsInNewWorkbook = 1
    With Workbooks.Add
        With .Sheets(1)
         ThisWorkbook.Sheets("Blad1").Range("A1:T103").Copy
           [A1].PasteSpecial Paste:=xlPasteValues
     .Parent.SaveAs "C:\Users\asus\Documents\Werk\" & "Tussen-Eindklassement" & ".xls"
        End With
    With Sheets(1)
       ThisWorkbook.Sheets("Blad2").Range("A1:D39").Copy
               [A1].PasteSpecial Paste:=xlPasteValues
            .Parent.SaveAs "C:\Users\asus\Documents\Werk\" & "Prijzenverdeling" & ".xls"
        End With
    End With
End Sub

 

[HSV]

Het ligt volgens mij niet aan Danny, maar aan Helpmij.nl.

De berichten die vandaag zijn gepost lijken allemaal verdwenen. :shocked:
Zelfs die gisteravond al waren opgelost zijn verdwenen.

Het lijkt hersteld, maar moet je de eerste topics zien.
#-2, #-1, #0

 

[Wigi]

Ik net als Leo, Danny.

Jouw voorbeeld leek op deze.
Heb een kleine aanpassing gedaan.

Misschien dat je het zo bedoeld.

Sub bladwegschrijven()
    Application.SheetsInNewWorkbook = 1
    With Workbooks.Add
        With .Sheets(1)
         ThisWorkbook.Sheets("Blad1").Range("A1:T103").Copy
           [A1].PasteSpecial Paste:=xlPasteValues
     .Parent.SaveAs "C:\Users\asus\Documents\Werk\" & "Tussen-Eindklassement" & ".xls"
        End With
    With Sheets(1)
       ThisWorkbook.Sheets("Blad2").Range("A1:D39").Copy
               [A1].PasteSpecial Paste:=xlPasteValues
            .Parent.SaveAs "C:\Users\asus\Documents\Werk\" & "Prijzenverdeling" & ".xls"
        End With
    End With
End Sub

Dag Harry

Bovenstaande code zou ik toch in een aparte procedure steken (met parameters) die dan x aantal keer aangesproken wordt (2 in dit geval).

Voor je het weet verandert er iets en kunnen de veranderingen dus 2 keer gedaan worden. Of moeten er 3 of 4 tabbladen gemaild worden en weet men niet beter dan code te gaan kopiëren.

Wigi

 

[HSV]

Hallo Wim,

Helaas heb ik daar niet bij stil gestaan, maar je hebt gelijk.
De procedure van de code zoals die is aangereikt door Danny heb ik eigenlijk gelaten voor wat het was.

Bedankt vvor de info.

 

[danny147]

Beste,

Zal deze middag de oplossingen eens bekijken, alvast bedankt allemaal.

@ Ginger

Bij jouw oplossing krijgen mijn waardes allemaam #N/B als resultaat.

Groetjes Danny. :thumb:

 

[Ginger]

@ Ginger, Bij jouw oplossing krijgen mijn waardes allemaal #N/B als resultaat.

Da's vreemd... Maak je soms gebruik van allemaal VLookup (vert.zoeken) functies? Naar mijn idee zou het dan nóg goed moeten gaan. Doorloop het blokje 'ns met F8 in de VBE en kijk 'ns wanneer je formules plotseling in de error veranderen?

Groet, Leo

 

[danny147]

Beste Ginger

Ik krijg geen foutmelding voor de code.
Krijg 1 bestandje met 2 tabbladen weer met de goede opmaak maar de gegevens zijn niet goed.

Beste HSV en Wigi

Bij jullie krijg ik 2 bestandje te zien met de goede gegevens maar de opmaak is dan weer niet goed.

Groetjes Danny.

 

[HSV]

Zo zou het kunnen Danny.

[A1].PasteSpecial Paste:=xlPasteFormats
[A1].PasteSpecial Paste:=xlPasteValues

 

[danny147]

Beste HSV

Bij [A1].PasteSpecial Paste:=xlPasteValues krijg ik de volgende foutmelding.
Hij zegt mij dat alle samengevoegde cellen dezelfde afmetingen moeten hebben.

Groetjes Danny. :thumb:

 

[HSV]

Samengevoegde cellen blijven altijd lastig.

 

[Ginger]

probeer 'm zo 'ns...

Sub bladwegschrijven()
    
'    Application.ScreenUpdating = False
    
    Sheets(Array("Tussen-Eindklassement", "Prijzenverdeling")).Copy after:=Sheets(Sheets.Count)
    For Each sh In Sheets(Array(Sheets(Sheets.Count - 1).Name, Sheets(Sheets.Count).Name))
        On Error Resume Next
        sh.Cells.SpecialCells(xlCellTypeFormulas).Value = sh.Cells.SpecialCells(xlCellTypeFormulas).Value
        On Error GoTo 0
    Next sh
    Sheets(Array(Sheets(Sheets.Count - 1).Name, Sheets(Sheets.Count).Name)).Move
    ActiveWorkbook.SaveAs "C:\Users\asus\Documents\Werk\Tussen-Eindklassement" & Date & ".xls"
    
'    Application.ScreenUpdating = True
    
End Sub

Als dit werkt, kan je de quotes weghalen bij de screenupdating. Dan zal alles op de 'achtergrond' gebeuren...

Groet, Leo

 

[danny147]

Beste Ginger

Ook deze lukt niet Leo

Heb het volgende gekregen van Daniël, zie bestandje.
Dit werkt perfect, alleen bij het afsluiten krijg ik een foutmelding.

Wat ik graag zou verwezenlijk wil hebben aan dit bestandje is het volgende:
Met dit bestandje kan ik maar 1 e-mail per keer versturen.
Is het mogelijk om de volgende code erin te verwerken ?
Zodat allemaal mijn e-mailadressen in kolom A staan en tergelijkertijd verstuurd worden.
De Userform mag weg in de code alsook de meldingen.
Wil het gewoon met een knop activeren.

    Dim MyArr As Variant
    MyArr = ThisWorkbook.Sheets("E-mailadressen").Range("A1:A100")
    .SendMail MyArr, "Overzicht"

Groetjes Danny. :thumb:

 

[danny147]

Beste Ginger, HSV, Wigi of misschien warme bakkertje

Misschien kan men hier op verder bouwen.

Groetjes Danny. :thumb:

 

[trucker10]

Hallo Danny en andere forum helpers
Ik heb op de site van Ron eens wat code gelezen en een stukje gebruikt om .......
Het userform staat er nog steeds , de foutmelding zat in ThisWorkBook daar stond een macrootje en module1 was ook niet nodig .
Danny ik zou zeggen op hoop dat er een Wigi , SNB , Warme Bakkertje , Leo of andere vba-er nog langs komt kan je deze toch al eens proberen of zij kunnen de code beperken tot wat je wil .
Edit ; Danny telepathy bestaat ik was met jouw berichtje bezig toen jij ook dezelfde roep neerschreef

 

[HSV]

Helaas moet ik je het antwoord schuldig blijven Danny.
Maar via/via heb ik vernomen dat je iets verder bent, maar zit je nog met de waarden, en samengevoegde cellen?

Heb iets in elkaar gestoken, om je #1 vraag te proberen te beantwoorden.

Dit is voor één tabblad, de code kopiëren en aanpassen voor tweede knop.

Sub bladwegschrijven()
  Application.SheetsInNewWorkbook = 1
       With Workbooks.Add          
          .Title = "Tussen-Eindklassement"
          .SaveAs "C:\Users\asus\Documents\Werk\" & "Tussen-Eindklassement" & ".xls"
         Workbooks("Tussen-Eindklassement.xls").Sheets(1).Range("A1:T103").Value = ThisWorkbook.Sheets("Blad1").Range("A1:T103").Value
       ThisWorkbook.Sheets(1).Range("A1:T103").Copy
     Range("A1:T103").PasteSpecial Paste:=xlPasteFormats
   Application.Goto [A1]
End With
    Application.SheetsInNewWorkbook = 3
End Sub