Boucles imbriquées

Bonjour, je suis nouveau sur ce site et débute en vba. Je sollicite votre aide pour améliorer une macro. Je joins ci-dessous le code que j'ai fait seul. Il fonctionne mais je suis obligé de le copier dans vba le nombre de fois que je veux faire l'action en modifiant les sélections (Range ("Bx"), Plaqx et Columns("x").

J'imagine qu'un truc beaucoup plus simple est possible à l'aide de boucles. L'idée est qu'il faudrait qu'à chaque boucle la sélection de départ (Plaq) augmente de 1 (B2, puis B3...) et la colonne à sélectionner par la suite augmente de 3 (Columns(4) puis (7)...) jusqu'à ce que la sélection de départ soit une cellule vide.

Evidemment tous les autres conseils pour améliorer le code seront les bienvenus.

En vous remerciant pour votre aide,

Sub Macro2()

'

' Macro2 Macro

Windows("Algorithme classe I.xls").Activate

Sheets("Feuil3").Select

Range("B2").Select

If Selection.Value <> "" Then

k = ActiveCell.Value

Windows("Patients_SA1.xlsm").Activate

Dim Plaq As String

Plaq = Workbooks("Algorithme classe I.xls").Worksheets("Feuil3").Range("B2")

If Existe(Plaq) Then

Sheets(k).Select

Rows("5:102").Select

Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlYes, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

Rows(5).SpecialCells(xlCellTypeConstants, 1).Cells(1).Select

ActiveCell.EntireColumn.Select

Selection.EntireColumn.Insert

ActiveCell.EntireColumn.Offset(0, 1).Select

Selection.Copy

ActiveCell.EntireColumn.Offset(0, -1).Select

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Windows("Algorithme classe I.xls").Activate

Sheets("Feuil2").Select

Columns(4).Select

Selection.Copy

Windows("Patients_SA1.xlsm").Activate

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Windows("Algorithme classe I.xls").Activate

Sheets("Feuil3").Select

Else

Windows("Algorithme classe I.xls").Activate

Sheets("Feuil3").Select

Range("B2").Select

ActiveCell.Value = "La feuille n'existe pas"

End If

Else: Exit Sub

End If

End Sub

Salut Matt25 et

de préference il faut nous joindre un fichier pour mieux comprendre.

sinon, j'avoue que je n'ai pas tout compris, mais à tester

Sub Macro2()
'
' Macro2 Macro

for i = 2 to 100 ' IL FAUT ABSOLUMENT ADAPTER LE CHIFFRE 100 !!!!!!!!!
Windows("Algorithme classe I.xls").Activate
Sheets("Feuil3").Select
Range("B" & i).Select
If Selection.Value <> "" Then
k = ActiveCell.Value
Windows("Patients_SA1.xlsm").Activate
Dim Plaq As String
Plaq = Workbooks("Algorithme classe I.xls").Worksheets("Feuil3").Range("B" & i)
If Existe(Plaq) Then
Sheets(k).Select
Rows("5:102").Select
Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows(5).SpecialCells(xlCellTypeConstants, 1).Cells(1).Select
ActiveCell.EntireColumn.Select
Selection.EntireColumn.Insert
ActiveCell.EntireColumn.Offset(0, 1).Select
Selection.Copy
ActiveCell.EntireColumn.Offset(0, -1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Algorithme classe I.xls").Activate
Sheets("Feuil2").Select
Columns(2 + i).Select
Selection.Copy
Windows("Patients_SA1.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Algorithme classe I.xls").Activate
Sheets("Feuil3").Select
Else
Windows("Algorithme classe I.xls").Activate
Sheets("Feuil3").Select
Range("B" & i).Select
ActiveCell.Value = "La feuille n'existe pas"
End If
Else: Exit Sub
End If
next i
End Sub

@+++ et

Bonjour et merci beaucoup pour votre réponse. Désolé, je n'ai pas pris le temps d'épurer les deux fichiers des données confidentielles avant de poser ma question.

En adaptant mon fichier votre code marche très bien. La seule chose qui ne convenait pas en l'état est que sur les actions :

Range("B" & i).Select => il fallait qu'à chaque boucle la cellule de la ligne suivante soit sélectionnée alors que pour

Columns(2 + i).Select => il fallait qu'à chaque boucle, 2 colonnes soient sautées (sélection de la colonne 4 puis de la colonne 7, 10, etc..)

Mais j'ai adapté mon fichier et ça marche très bien. Merci beaucoup pour votre réactivité et votre compétence et promis la prochaine fois je joins les fichiers.