Fusionner plusieurs sub

Bonjour,

J'ai un fichier dont je veux générer automatiquement différentes versions dans lesquelles seront supprimées certaines certaines lignes et colonnes selon le service destinataire (j'ai une colonne pour chaque destinataire où je met la valeur 4 si cela a déjà été transmis, comme cela je lui transmet uniquement ce qu'il n'a pas encore eu et supprime les lignes déjà transmises, ici colonne n°22).

J'ai réussi à le faire pour un destinataire, mais je n'arrive pas à le faire 3 fois dans la même sub.

Mon problème est que je lui dit de le faire de la ligne 3 à 300 (le nombre de ligne du fichier pouvant varier) et donc j'ai mis un Exit Sub quand il détecte une cellule vide pour ne pas tourner en boucle (j'ai bien évidemment mis ce test sur une colonne qui est toujours remplie quand la ligne existe). Je voudrais donc lui dire que si la ligne est vide c'est qu'il a finit et qu'il passe à la création suivante (donc recommencer à zéro mais avec d'autres paramètres).

Je précise que j'ai essayé de réintégrer le code complet à la place du exit sub, mais je dois me mélanger les pinceaux et je me retrouve avec des conflits de boucle.

(précision je suis sur Excel 2003)

Merci d'avance ;)


Dim c As String
Dim b, d As Integer

Sub 1()
Dim objWorkbookCible As Workbook
Dim objworkbooksource As Workbook
Set objworkbooksource = ActiveWorkbook
Worksheets(7).Copy
Set objWorkbookCible = ActiveWorkbook
MaDate = Format(Date, "YYYY-MM-DD")
ActiveWorkbook.SaveAs Filename:="C:\Dossier1\" & "Transmission 1 " & MaDate & ".xls"

For b = 3 To 300
Cells(b, 7).Select
c = Selection.Value
If c = "" Then
ActiveSheet.Columns(6).EntireColumn.Delete
ActiveSheet.Columns(26).EntireColumn.Delete
ActiveSheet.Columns(25).EntireColumn.Delete
ActiveSheet.Columns(24).EntireColumn.Delete
ActiveSheet.Columns(23).EntireColumn.Delete
ActiveSheet.Columns(22).EntireColumn.Delete
Exit Sub
End If
Cells(b, 22).Select
d = Selection.Value
If d = 4 Then
ActiveSheet.Rows(b).EntireRow.Delete
b = b - 1
End If
Next
End Sub