Boucle qui stoppe sur cellule vide

Bonjour à tous,

J'aurais besoin de vous pour me sortir d'un casse-tête

Dans un classeur , j'ai plusieurs onglets (étant variable) qui représente des noms de Stagiaire

Les feuilles sont identiques, seul les données changent

Bon, j'ai réussi jusque là à rappatrier mes données.

Le problème, c'est que si une fiche de stagiaire (Onglet) n'a pas de stage, la procèdure s'arrête et ne poursuit plus la recherche

Il y aurait-il une astuce pour lui dire que si dans la fiche sélectionné, la cellule D24 est vide, passer le chemin est continuer

Merci d'avance

Sub Stages()
Dim i As Integer, j As Integer, k As Integer, lr As Integer, derligne As Integer, MaPlage As Range

Sheets("Stage").Select
Range("a1").Select
Range("c6:L1000").ClearContents
For k = 5 To 100 Step 1
    For j = 1 To Worksheets.Count
        If Worksheets(j).Name = Cells(k, 2).Value Then
            Sheets(j).Select

            derligne = Range("d35").End(xlUp).Row
            For i = 24 To derligne
                Sheets(j).Select
                Sheets(j).Unprotect

                Set MaPlage = Range("d" & i & ":f" & i)
                MaPlage.Select
                Selection.Copy
                Sheets("Stage").Select
                lr = Range("c1000").End(xlUp).Row + 1
                Cells(lr, 3).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False

                Cells(lr, 12).Select
                Cells(lr, 12) = Cells(k, 2).Value

            Next i

        End If
    Next j
Next k
Sheets("Stage").Select
Range("a1").Select
End Sub

Bonjour,

sur base du code fourni, je ne vois d'instruction qui ferait que le programme s'arrête en cas de cellule vide en D24.

peux-tu nous mettre ton fichier ?

Bonjour et merci de prendre en compte ma demande

Le fichier est trop gros, mais ce qui bloque, c'est justement quand la procèdure cherche dans la plage et arrive à la cellule D24 d'un onglet (date de stage), si le stagiaire n'a pas encore fait de stage, la cellule est vide et la procèdure stoppe

Peux-tu mettre un extrait de ton fichier dans lequel tu peux reproduire ton problème ?

Bonjour,

essaie :

derligne = Range("d35").End(xlUp).Row
if derligne>23 then 
   ....
end if

eric

Bonjour

Ah je veux tenter une explication

C'est le fait de faire des Select qui bloque le programme

For k = 5 To 100 Step 1
    For j = 1 To Worksheets.Count
        If Worksheets(j).Name = Cells(k, 2).Value Then
            Sheets(j).Select

Dès qu'il trouve la bonne page il la sélectionne, mais si par hasard la boucle

For i = 24 To derligne

ne se fait pas car derligne est plus petit que 24, on reste sur la page sélectionnée donc la boucle

For k = 5 To 100 Step 1

va bien continuer mais la comparaison

If Worksheets(j).Name = Cells(k, 2).Value Then

se fera avec une valeur de la page sélectionnée et non comme elle devrait se faire avec la page "Stage"

Mon petit code mais sans fichier

Sub Stages()
Dim i As Integer, j As Integer, k As Integer, lr As Integer, derligne As Integer, MaPlage As Range

  Sheets("Stage").Select
  Range("a1").Select
  Range("c6:L1000").ClearContents
  lr = Range("C1000").End(xlUp).Row + 1
  For k = 5 To 100 Step 1
    For j = 1 To Worksheets.Count
      If Worksheets(j).Name = Cells(k, 2).Value Then
        With Sheets(j)
          .Unprotect
          derligne = .Range("d35").End(xlUp).Row
          For i = 24 To derligne
            .Range("D" & i & ":F" & i).Copy Range("C" & lr)
            Range("L" & lr) = Range("B" & k).Value
            lr = lr + 1
          Next i
          .Protect
        End With
      End If
    Next j
  Next k
End Sub

Bonsoir et merci à vous de votre participation.

Bon ben, non, çà marche pas non plus (Du moins, cela bloque au niveau du

.Range("d" & i & ":f" & i).Copy Range("C" & lr)

Mais j'ai contourné le problème en mettant un caractère dans la première cellule vide de de chaque onglet. Ce qui fait qu'il me prend tous les onglets et n'inscrit que mon caractères quand il n'y a pas de stage

Merci à vous

Mais je suis toujours preneur, d'une autre soluce

Bonjour

M12 a écrit :

cela bloque

Avec la traduction cela donne ?

Message d'erreur ?

Si oui lequel ?

M12 a écrit :

Mais je suis toujours preneur, d'une autre soluce

Cela me donne:

Erreur d'execution 1004

La méthode Copy de la classe Range a échoué

Bonjour

Cela ne m'avance pas plus

Suis étonné de ce message mais sans fichier test je ne saurai pas

Bonjour Banzaï

Ci-joint un exemple de mon fichier qui reproduitma demande

il y a ma Procèdure et la tienne

Merci d'avance

11stage.xlsm (76.24 Ko)

Bonjour

Ah mais le message d'erreur que tu m'as dit n'est pas le même que j'obtiens

"Impossible de modifier une cellule fusionnée"

Je comprends mieux maintenant

Modifie le code

Sub Stages2()
Dim i As Integer, j As Integer, k As Integer, lr As Integer, derligne As Integer, MaPlage As Range

  Sheets("Stage").Select
  Range("a1").Select
  Application.ScreenUpdating = False
  Range("C6:L1000").ClearContents
  lr = Range("C1000").End(xlUp).Row + 1
  For k = 5 To Range("B" & Rows.Count).End(xlUp).Row
    For j = 1 To Worksheets.Count
      If Worksheets(j).Name = Cells(k, 2).Value Then
        With Sheets(j)
          .Unprotect
          derligne = .Range("d35").End(xlUp).Row
          For i = 24 To derligne
            Range("C" & lr) = .Range("D" & i)
            Range("E" & lr) = .Range("F" & i)
            '.Range("D" & i & ":F" & i).Copy Range("C" & lr)
            Range("L" & lr) = Range("B" & k).Value
            lr = lr + 1
          Next i
          .Protect
        End With
      End If
    Next j
  Next k
End Sub

bonjour,

proposition de correction sur base de ton code (sans optimisation)

Option Explicit
Sub Stages() 'Ma version
Dim i As Integer, j As Integer, k As Integer, lr As Integer, derligne As Integer, MaPlage As Range

Sheets("Stage").Select
Range("a1").Select
Range("c6:l100").ClearContents
For k = 5 To 100 Step 1
    For j = 1 To Worksheets.Count
        If Worksheets(j).Name = Cells(k, 2).Value Then '(k,2= la liste des noms des onglets existant
            Sheets(j).Select
            derligne = Range("d35").End(xlUp).Row
            For i = 24 To derligne
                Sheets(j).Select
                Sheets(j).Unprotect
                Set MaPlage = Range("d" & i & ":f" & i) 'récupère de la colonne D à F, mais je voudrait ne pas avoir la colonne E
                MaPlage.Select
                Selection.Copy
                Sheets("Stage").Select
                lr = Range("c100").End(xlUp).Row + 1
                Cells(lr, 3).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False

                Cells(lr, 12).Select
                Cells(lr, 12) = Cells(k, 2).Value
            Next i
        End If
        Sheets("stage").Select
    Next j
Next k

Range("a1").Select
End Sub

Bonjour Banzaï et merci

C'est tout nickel.

Pourtant le F8 je l'ai balancé et re-balancé, et simplement ce p'tit "turc" à la mausaise place

Bonne journée

Rechercher des sujets similaires à "boucle qui stoppe vide"