Imbrication de deux boucles

Bonjour à tous,

Voici mon code actuel :

Sub SuiteCR()

'Definition des Variables

Dim NomCR As String

Dim Marche As String

Dim Col As Integer

Dim Ligne As Integer

Dim CA13 As Integer

Dim CA14 As Integer

Dim FP13 As Integer

Dim FP14 As Integer

Dim Marge13 As Integer

Dim Marge14 As Integer

CA13 = 17

CA14 = 29

FP13 = 41

FP14 = 53

Marge13 = 65

Marge14 = 77

Col = 1

Ligne = 2

While Sheets("Regroupement").Cells(Ligne, Col).Value <> ""

'Définition de la boucle pour additionner les marché sur le regroupement CR

NomCR = Sheets("Regroupement").Cells(1, Col)

NomMarche = Sheets("Regroupement").Cells(Ligne, Col)

'Copie CA13

Sheets(NomMarche).Select 'Selection de la zone à Copier

Range("C5:C132").Select

selection.Copy

Sheets(NomCR).Select

Cells(5, CA13).Select

ActiveSheet.Paste

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

:=False, Transpose:=False

Application.CutCopyMode = False

'Copie CA14

Sheets(NomMarche).Select 'Selection de la zone à Copier

Range("D5:D132").Select

selection.Copy

Sheets(NomCR).Select

Cells(5, CA14).Select

ActiveSheet.Paste

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

:=False, Transpose:=False

Application.CutCopyMode = False

'Copie FP13

Sheets(NomMarche).Select 'Selection de la zone à Copier

Range("S5:S132").Select

selection.Copy

Sheets(NomCR).Select

Cells(5, FP13).Select

ActiveSheet.Paste

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

:=False, Transpose:=False

Application.CutCopyMode = False

'Copie Fp14

Sheets(NomMarche).Select 'Selection de la zone à Copier

Range("T5:T132").Select

selection.Copy

Sheets(NomCR).Select

Cells(5, FP14).Select

ActiveSheet.Paste

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

:=False, Transpose:=False

Application.CutCopyMode = False

'Copie Marge 13

Sheets(NomMarche).Select 'Selection de la zone à Copier

Range("W5:W132").Select

selection.Copy

Sheets(NomCR).Select

Cells(5, Marge13).Select

ActiveSheet.Paste

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

:=False, Transpose:=False

Application.CutCopyMode = False

'Copie Marge14

Sheets(NomMarche).Select 'Selection de la zone à Copier

Range("T5:T132").Select

selection.Copy

Sheets(NomCR).Select

Cells(5, Marge14).Select

ActiveSheet.Paste

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

:=False, Transpose:=False

Application.CutCopyMode = False

CA13 = CA13 + 1

CA14 = CA14 + 1

FP13 = FP13 + 1

FP14 = FP14 + 1

Marge13 = Marge13 + 1

Marge14 = Marge14 + 1

Ligne = Ligne + 1

Wend

End Sub

J'aimerai bien en fait qu'une fois la boucle terminée je puisse la relancer.

Relancer l'ensemble de cette boucle mais en rajoutant : Col = Col +1

While While Sheets("Regroupement").Cells1, Col).Value <> ""

Col = Col +1

Wend

J'ai essayé de coder mais malheureusement cela ne fonctionne pas une fois la première boucle terminé cela ne repart pas ...

Bonjour,

à mon avis tu devrais ajouter

ligne=2 ' pour recommencer la nouvelle boucle à la ligne 2
col=col+1