VBA MACRO boucle for non fonctionnel

Le 11/07/2018 à 21:26

Bonsoir,

Je me présente à vous aujourdhui afin de demander votre aide sur une macro VBA avec une boucle FOR qui ne fonctionne pas.

Voici la macro (module 6)

Sub canceled()

Dim I As Integer

With Sheets("Suivi groupe salle victoire")

For I = 2 To 1400 Step 1

J = 1000

If .Cells(I, "M") = "CXL" Then

.Cells(I, "A").Copy Worksheets("Seminaire annulé").Cells(J, "A")

.Cells(I, "E").Copy Worksheets("Seminaire annulé").Cells(J, "B")

.Cells(I, "S").Copy Worksheets("Seminaire annulé").Cells(J, "C")

.Cells(I, "T").Copy Worksheets("Seminaire annulé").Cells(J, "D")

.Cells(I, "M").Copy Worksheets("Seminaire annulé").Cells(J, "E")

End If

J = J + 1

Next I

End With

With Sheets("Suivi groupe salle fourviere")

DerLign = 1400

For I = DerLign To 2 Step -1

J = 1200

If .Cells(I, "M") = "CXL" Then

.Cells(I, "A").Copy Worksheets("Seminaire annulé").Cells(J, "A")

.Cells(I, "E").Copy Worksheets("Seminaire annulé").Cells(J, "B")

.Cells(I, "S").Copy Worksheets("Seminaire annulé").Cells(J, "C")

.Cells(I, "T").Copy Worksheets("Seminaire annulé").Cells(J, "D")

.Cells(I, "M").Copy Worksheets("Seminaire annulé").Cells(J, "E")

J = J + 1

End If

Next I

Range("A2:E1844").Select

ActiveWorkbook.Worksheets("Seminaire annulé").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Seminaire annulé").Sort.SortFields.Add Key:=Range( _

"A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

xlSortNormal

With ActiveWorkbook.Worksheets("Seminaire annulé").Sort

.SetRange Range("A2:E1200")

.Header = xlGuess

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

End With

End Sub

Je souhaiterai prendre les lignes dont CXL est le statut, puis les coller mais en ligne 1000 afin de garder toujours une trace de mes annulations.

Merci d'avance

Quentin

40creation-suivi-groupe.xlsm (217.78 Ko)
Le 11/07/2018 à 22:54

Bonjour,

Pas sûr d'avoir tout bien compris ...

À tester :

Sub canceled()
Dim I As Integer
Dim J As Integer
Dim DerLign As Integer

With Sheets("Suivi groupe salle victoire")
   J = 1000
   For I = 2 To 1400
      If .Cells(I, "M") = "CXL" Then
         .Cells(I, "A").Copy Worksheets("Seminaire annulé").Cells(J, "A")
         .Cells(I, "E").Copy Worksheets("Seminaire annulé").Cells(J, "B")
         .Cells(I, "S").Copy Worksheets("Seminaire annulé").Cells(J, "C")
         .Cells(I, "T").Copy Worksheets("Seminaire annulé").Cells(J, "D")
         .Cells(I, "M").Copy Worksheets("Seminaire annulé").Cells(J, "E")
      End If
      J = J + 1
   Next I
End With

With Sheets("Suivi groupe salle fourviere")
   DerLign = 1400
   J = 1200

   For I = DerLign To 2 Step -1
      If .Cells(I, "M") = "CXL" Then
         .Cells(I, "A").Copy Worksheets("Seminaire annulé").Cells(J, "A")
         .Cells(I, "E").Copy Worksheets("Seminaire annulé").Cells(J, "B")
         .Cells(I, "S").Copy Worksheets("Seminaire annulé").Cells(J, "C")
         .Cells(I, "T").Copy Worksheets("Seminaire annulé").Cells(J, "D")
         .Cells(I, "M").Copy Worksheets("Seminaire annulé").Cells(J, "E")
      End If
      J = J + 1
   Next I

   With Worksheets("Seminaire annulé")   '''.Range("A2:E1844").Select
      .Sort.SortFields.Clear
      .Sort.SortFields.Add Key:=Range("A2"), _
           SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      With .Sort
         .SetRange Range("A2:E1200")
         .Header = xlGuess
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
      End With
   End With
End With
End Sub

ric

Le 12/07/2018 à 00:21

Merci de ton aide ric, c'était exactement cela

Rechercher des sujets similaires à "vba macro boucle fonctionnel"