Boucle et envoi de mail

Bonjour à tous,

j'ai un fichier avec une macro qui me permet d'envoyer par mail un tableau Excel en pdf, ( ci joint ) ,

ce que je souhaiterai maintenant c'est qu'une fois le premier mail parti : la cellule u1 de l'onglet depart , aille chercher la valeur de la cellule =Total!B3 envoi le mail puis aille chercher la valeur de la cellule =Total!B4 puis aille chercher la valeur de la cellule =Total!B5 etc ... jusqu' a la dernière cellule vide de la colonne F de l'onglet Total.

J'ai cherché sur différents post du site mais jamais sans trouver vraiment ce que je voulais,

Est ce que vous pourriez m'aider ?

Merci à vous,

Cdt,

.... :(

personne pour m'aider ,

please

Bonjour,

Pour ma part, le fichier joint est difficile d'accès, idem pour le code VBA.

J'ai l'impression que la demande consiste simplement à réaliser une boucle de la colonne "B".

Ci-après, un point de départ qui parcourt et affiche les cellules en question.

A associer ensuite avec votre code d'envoi de mail.

Option Explicit

Sub boucle()
    Dim i, imax As Integer
    ' Nombre de lignes à parcourir dans la colonne B
    imax = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets("Total").Range("B:B"))
    ' Boucle
    For i = 1 To imax
        ' Affichage successif des valeurs des cellules
        MsgBox (ThisWorkbook.Worksheets("Total").Range("B" & (i + 1)))
    Next
End Sub

A vous lire,

Bonjour et merci pour votre retour ,

je ne comprends pas ou placé ce code, le voici en intégralité :

J'ai essayé de le mettre en début mais ca ne fonctionne pas... qu'est ce que vous entendez par difficile d'accès ?

Merci à vous encore,

Cdt,

Sub Envoi()
'

'Columns("G:J").Select
'Selection.EntireColumn.Hidden = True

Dim i, imax As Integer
' Nombre de lignes à parcourir dans la colonne B
imax = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets("Total").Range("B:B"))
' Boucle
For i = 1 To imax
' Affichage successif des valeurs des cellules
MsgBox (ThisWorkbook.Worksheets("Total").Range("B" & (i + 1)))
Next

Dim i As Integer

DisplayJourSem = Range("u2").Value

Select Case DisplayJourSem
Case "Allemand"
Application.Union(Range("a1:a1"), Range("c1:c1"), Range("h1:h1"), Range("k1:k1"), Range("m1:m1")).Select

Selection.EntireColumn.Hidden = True

Range("P1:R1").Select

Case "Anglais"
Application.Union(Range("a1:a1"), Range("b1:b1"), Range("h1:h1"), Range("k1:k1"), Range("l1:l1")).Select

Selection.EntireColumn.Hidden = True

Range("P1:R1").Select

Case "Français"
Application.Union(Range("b1:b1"), Range("c1:c1"), Range("h1:h1"), Range("l1:l1"), Range("m1:m1")).Select

Selection.EntireColumn.Hidden = True

Range("P1:R1").Select


Case ""
MsgBox ("Pas de dimanche dans le tableau")
Case Else
MsgBox ("Mauvaise saisie dans la cellule a1")
End Select



Selection.EntireColumn.Hidden = True

Application.ScreenUpdating = False

'For i = 15 To 300
'If WorksheetFunction.Sum(Range("K" & i & ":P" & i)) = 0 Then Rows(i).EntireRow.Hidden = True
'Next i

'Fonctionne sous excel 2000-2013
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim NoSem As Integer 'xxxxx

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

NoSem = Range("N5").Value 'recup numero semaine
mail = Range("u3").Value
fournisseur = Range("U2").Value
client = Range("U1").Value

Set Sourcewb = ActiveWorkbook

'Copie la feuille active comme nouvelle feuille

ActiveSheet.Copy
Set destwb = ActiveWorkbook

'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
'----------------------------------------------------------------------------

TempFilePath = Environ$("temp") & "\"
TempFileName = client & " Semana " & NoSem

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf

On Error Resume Next
With OutMail
.To = mail
.CC = ""
.bcc = ""
.Subject = "OFFRE LEGROSBIO S" & NoSem & " - " & client
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour ,
'xxxxx

'send ' pour envoyer
.display 'pour visualiser
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With


Columns("A:N").Hidden = False

End Sub

En fait au lieu que ce soit dans un msg box je voudrais que le nom du client s'affiche en cellule U1 de l'onglet départ,

Cdt,

Difficile d'accès au sens où le code n'est pas (ou peu) indenté et qu'il n'est pas décomposé en sous-fonctions / procédures.

Le msgbox était un exemple à adapter, mais cela dépend de votre niveau en VBA.

Cela donne ceci alors :

Sub boucle()
    Dim i, imax As Integer
    ' Nombre de lignes à parcourir dans la colonne B
    imax = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets("Total").Range("B:B"))
    ' Boucle
    For i = 1 To imax
        ' Affichage successif des valeurs des cellules
        ThisWorkbook.Worksheets("depart").range("U1") = ThisWorkbook.Worksheets("Total").Range("B" & (i + 1)))
        ' Insérer ici les instructions d'envoi
    Next
End Sub

Il faudrait alors, juste après cet ligne, appeler votre macro "envoi" sous réserve qu'elle fonctionne bien de cette manière.

Voici le code que j'obtiens :

Sub boucle2()
Dim i, imax As Integer
' Nombre de lignes à parcourir dans la colonne B
imax = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets("Total").Range("B:B"))
' Boucle
For i = 1 To imax
' Affichage successif des valeurs des cellules
ThisWorkbook.Worksheets("depart").Range("U1") = ThisWorkbook.Worksheets("Total").Range("B" & (i + 1))
' Insérer ici les instructions d'envoi

Call Envoi


Next


End Sub

et voici le message d'erreur :

Pourtant ma macro envoi , fait bien le travail mais uniquement pour la premiere ligne deja saisi,

Merci infiniment,

Cdt;

RAS désolé tout fonctionne correctement ,

merci encore vous êtes génial !!!!!

Ravi d'avoir pu vous aider