Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

[VBA] XL 2003 - action si filtre

2 réponses
Avatar
Congelator
Salut tout le monde,
j'ai encore besoin de vous. Voilà mon problème :
Une feuille (Liste) avec ~10'000 lignes correspondants aux nom, prénom,
adresses, email, etc... A l'aide d'une macro, je recopie toutes les adresses
email qui se trouvent en H (mais pas forcément dans toutes les cellules) dans
A1, en feuil2 (Mailing) afin que l'utilisateur n'aie pas à les retaper une à
une pour envoyer son email. Par contre, l'utilisateur pourrait poser des
filtres de A à H (que telle région, que tel secteur, ...) et dans ce cas, je
ne veux pas reprendre les 10'000 emails, seulement celles qui sont filtrées.
Je vous rassure, ce n'est pas pour faire des spam :-), c'est pour gérer les
envois d'informations demandées par les clients.

Voilà ma macro. Si qqn a une idée pour intégrer cette condition, un grand
merci d'avance.
Sub Macro1()

Dim listeEmail As String
Dim testCellVide As String
Dim nbrErreur As Integer

Err.Clear
On Error Resume Next
Sheets("Liste").Select
nbrErreur = Err.Number
Err.Clear
On Error GoTo 0
If nbrErreur > 0 Then
MsgBox "La macro ne s'est pas exécutée car l'onglet * Liste * a été
renommé."
Else
Range("A2").Select
On Error Resume Next
Do
If ActiveCell.Offset(0, 7).Range("A1").Value <> "" Then
listeEmail = listeEmail & ActiveCell.Offset(0,
7).Range("A1").Value & ","
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Loop Until ActiveCell.Value = ""
nbrErreur = Err.Number
Err.Clear
On Error GoTo 0
If nbrErreur > 0 Then
MsgBox "Une modification a été effectuée durant l'exécution de
la macro. Merci de la réexécuter."
Else
On Error Resume Next
Sheets("Mailing").Select
nbrErreur = Err.Number
Err.Clear
On Error GoTo 0
If nbrErreur > 0 Then
MsgBox "La macro ne s'est pas exécutée car l'onglet *
Mailing * a été renommé."
Else
Range("A1").Select
ActiveCell.FormulaR1C1 = listeEmail
End If
End If
End If
End Sub

--
Céd / Lausanne

2 réponses

Avatar
Daniel.C
Bonsoir.
Pour faire une modif à minima, remplace :
If ActiveCell.Offset(0, 7).Range("A1").Value <> "" Then
par :
If ActiveCell.Offset(0, 7).Value <> "" And _
ActiveCell.EntireRow.Hidden = False Then
Daniel

Salut tout le monde,
j'ai encore besoin de vous. Voilà mon problème :
Une feuille (Liste) avec ~10'000 lignes correspondants aux nom, prénom,
adresses, email, etc... A l'aide d'une macro, je recopie toutes les adresses
email qui se trouvent en H (mais pas forcément dans toutes les cellules) dans
A1, en feuil2 (Mailing) afin que l'utilisateur n'aie pas à les retaper une à
une pour envoyer son email. Par contre, l'utilisateur pourrait poser des
filtres de A à H (que telle région, que tel secteur, ...) et dans ce cas, je
ne veux pas reprendre les 10'000 emails, seulement celles qui sont filtrées.
Je vous rassure, ce n'est pas pour faire des spam :-), c'est pour gérer les
envois d'informations demandées par les clients.

Voilà ma macro. Si qqn a une idée pour intégrer cette condition, un grand
merci d'avance.
Sub Macro1()

Dim listeEmail As String
Dim testCellVide As String
Dim nbrErreur As Integer

Err.Clear
On Error Resume Next
Sheets("Liste").Select
nbrErreur = Err.Number
Err.Clear
On Error GoTo 0
If nbrErreur > 0 Then
MsgBox "La macro ne s'est pas exécutée car l'onglet * Liste * a été
renommé."
Else
Range("A2").Select
On Error Resume Next
Do
If ActiveCell.Offset(0, 7).Range("A1").Value <> "" Then
listeEmail = listeEmail & ActiveCell.Offset(0,
7).Range("A1").Value & ","
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Loop Until ActiveCell.Value = ""
nbrErreur = Err.Number
Err.Clear
On Error GoTo 0
If nbrErreur > 0 Then
MsgBox "Une modification a été effectuée durant l'exécution de
la macro. Merci de la réexécuter."
Else
On Error Resume Next
Sheets("Mailing").Select
nbrErreur = Err.Number
Err.Clear
On Error GoTo 0
If nbrErreur > 0 Then
MsgBox "La macro ne s'est pas exécutée car l'onglet *
Mailing * a été renommé."
Else
Range("A1").Select
ActiveCell.FormulaR1C1 = listeEmail
End If
End If
End If
End Sub


Avatar
Congelator
tout simplement GE - NIAL ! c'est ce que je voulais. Un grand merci Daniel.

--
Céd / Lausanne


"Daniel.C" a écrit :

Bonsoir.
Pour faire une modif à minima, remplace :
If ActiveCell.Offset(0, 7).Range("A1").Value <> "" Then
par :
If ActiveCell.Offset(0, 7).Value <> "" And _
ActiveCell.EntireRow.Hidden = False Then
Daniel

> Salut tout le monde,
> j'ai encore besoin de vous. Voilà mon problème :
> Une feuille (Liste) avec ~10'000 lignes correspondants aux nom, prénom,
> adresses, email, etc... A l'aide d'une macro, je recopie toutes les adresses
> email qui se trouvent en H (mais pas forcément dans toutes les cellules) dans
> A1, en feuil2 (Mailing) afin que l'utilisateur n'aie pas à les retaper une à
> une pour envoyer son email. Par contre, l'utilisateur pourrait poser des
> filtres de A à H (que telle région, que tel secteur, ...) et dans ce cas, je
> ne veux pas reprendre les 10'000 emails, seulement celles qui sont filtrées.
> Je vous rassure, ce n'est pas pour faire des spam :-), c'est pour gérer les
> envois d'informations demandées par les clients.
>
> Voilà ma macro. Si qqn a une idée pour intégrer cette condition, un grand
> merci d'avance.
> Sub Macro1()
>
> Dim listeEmail As String
> Dim testCellVide As String
> Dim nbrErreur As Integer
>
> Err.Clear
> On Error Resume Next
> Sheets("Liste").Select
> nbrErreur = Err.Number
> Err.Clear
> On Error GoTo 0
> If nbrErreur > 0 Then
> MsgBox "La macro ne s'est pas exécutée car l'onglet * Liste * a été
> renommé."
> Else
> Range("A2").Select
> On Error Resume Next
> Do
> If ActiveCell.Offset(0, 7).Range("A1").Value <> "" Then
> listeEmail = listeEmail & ActiveCell.Offset(0,
> 7).Range("A1").Value & ","
> End If
> ActiveCell.Offset(1, 0).Range("A1").Select
> Loop Until ActiveCell.Value = ""
> nbrErreur = Err.Number
> Err.Clear
> On Error GoTo 0
> If nbrErreur > 0 Then
> MsgBox "Une modification a été effectuée durant l'exécution de
> la macro. Merci de la réexécuter."
> Else
> On Error Resume Next
> Sheets("Mailing").Select
> nbrErreur = Err.Number
> Err.Clear
> On Error GoTo 0
> If nbrErreur > 0 Then
> MsgBox "La macro ne s'est pas exécutée car l'onglet *
> Mailing * a été renommé."
> Else
> Range("A1").Select
> ActiveCell.FormulaR1C1 = listeEmail
> End If
> End If
> End If
> End Sub