Boucle avec arrêt

Bonjour,

J'ai un fichier généalogique contenant les données des parents (col. 1-16) et des enfants (col. 17-20).

J'ai créé une macro de mise en page mais je voudrais arrêter la boucle si le couple n'a pas d'enfant ou 1 seul ( la colonne 17 et/ou la colonne 19 sont vides).

Je joins le fichier avec la macro.

Ci-dessous le code commenté

Merci

Sub boucle_arret()
'
' boucle_arret Macro
'
''''''''''''''''''''''''''''''''''''''
' Compteur de lignes dans la feuille "Origine"
For i = 1 To 4
' Compteur de lignes dans la feuille "Résultats / 
' à paramétrer en fonction du nbr d'enfants possibles dans le tableau "Origine"
j = (i - 1) * 3
''''''''''''''''''''''''''''''''''''''
'
Sheets("Origine").Select
'
acte$ = ""
acte$ = Cells(i, 1).Value
'
laDateActe$ = ""
laDateActe$ = Cells(i, 2).Value
'
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Donnés du père
'''''''''''''''''''''''''''''''''''''''''''''''''''
'
leNom1$ = ""
leNom1$ = Cells(i, 3).Value
'
lePrenom1$ = ""
lePrenom1$ = Cells(i, 4).Value
'
leLieu1$ = ""
leLieu1$ = Cells(i, 5).Value
'
lePrenomPere1$ = ""
lePrenomPere1$ = Cells(i, 6).Value
'
leNomMere1$ = ""
leNomMere1$ = Cells(i, 7).Value
'
lePrenomMere1$ = ""
lePrenomMere1$ = Cells(i, 8).Value
'
observ1$ = ""
observ1$ = Cells(i, 9).Value
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Données de la mère
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
leNom2$ = ""
leNom2$ = Cells(i, 10).Value
'
lePrenom2$ = ""
lePrenom2$ = Cells(i, 11).Value
'
leLieu2$ = ""
leLieu2$ = Cells(i, 12).Value
'
lePrenomPere2$ = ""
lePrenomPere2$ = Cells(i, 13).Value
'
leNomMere2$ = ""
leNomMere2$ = Cells(i, 14).Value
'
lePrenomMere2$ = ""
lePrenomMere2$ = Cells(i, 15).Value
'
observ2$ = ""
observ2$ = Cells(i, 16).Value
'
'''''''''''''''''''''''''''''''''''''
' le 1er Enfant
'''''''''''''''''''''''''''''''''''''
'
lePrenomEnf_1$ = ""
lePrenomEnf_1$ = Cells(i, 17).Value
'
leComEnf1$ = ""
leComEnf1$ = Cells(i, 18).Value
'
'''''''''''''''''''''''''''''''''''''''''''''
' le 2eme Enfant
'''''''''''''''''''''''''''''''''''''''''''''
'
lePrenomEnf2$ = ""
lePrenomEnf2$ = Cells(i, 19).Value
'
leComEnf2$ = ""
leComEnf2$ = Cells(i, 20).Value
'
'''''''''''''''''''''''''''''''
' Mise en page des données    '
' dans la feuille "Résultats" '
'''''''''''''''''''''''''''''''
'
With Sheets("Resultat").Select
' Le couple
Cells(j + 1, 1).Value = acte$
Cells(j + 1, 2).Value = laDateActe$
Cells(j + 1, 3).Value = UCase(leNom1$)
Cells(j + 1, 4).Value = lePrenom1$
Cells(j + 1, 5).Value = leLieu1$
Cells(j + 1, 6).Value = lePrenomPere1$
Cells(j + 1, 7).Value = UCase(leNomMere1$)
Cells(j + 1, 8).Value = lePrenomMere1$
Cells(j + 1, 9).Value = observ1$
Cells(j + 1, 10).Value = UCase(leNom2$)
Cells(j + 1, 11).Value = lePrenom2$
Cells(j + 1, 12).Value = leLieu2$
Cells(j + 1, 13).Value = lePrenomPere2$
Cells(j + 1, 14).Value = UCase(leNomMere2$)
Cells(j + 1, 15).Value = lePrenomMere2$
Cells(j + 1, 16).Value = observ2$
lePrenomEnf1$ = ""
lePrenomEnf1$ = Cells(j + 1, 17).Value
'
' 1er enfant
'
' If lePrenomEnf_1$ = "" Or " " Then End With ' error !!!
'
Cells(j + 2, 1).Value = acte$
Cells(j + 2, 2).Value = laDateActe$
Cells(j + 2, 3).Value = UCase(leNom1$)
Cells(j + 2, 4).Value = lePrenomEnf_1$
Cells(j + 2, 5).Value = ""
Cells(j + 2, 6).Value = lePrenom1$
Cells(j + 2, 7).Value = UCase(leNom2$)
Cells(j + 2, 8).Value = lePrenom1$
Cells(j + 2, 9).Value = leComEnf1$
'
' 2eme enfant
'
' If lePrenomEnf_1$ = "" Or " " Then End With ' Error !!!
'
Cells(j + 3, 1).Value = acte$
Cells(j + 3, 2).Value = laDateActe$
Cells(j + 3, 3).Value = UCase(leNom1$)
Cells(j + 3, 4).Value = lePrenomEnf2$
Cells(j + 3, 5).Value = ""
Cells(j + 3, 6).Value = lePrenom1$
Cells(j + 3, 7).Value = UCase(leNom2$)
Cells(j + 3, 8).Value = lePrenom2$
Cells(j + 3, 9).Value = leComEnf2$
End With
Next i
End Sub

Bonjour

A vérifier (J'ai essayé de suivre toutes tes variables, mais je ne suis pas à l'abri d'erreurs)

Sub boucle_arret()
Dim WsOrig As Worksheet
Dim WsResu As Worksheet
Dim J As Long
Dim Ligne As Long

  Set WsOrig = Sheets("Origine")
  Set WsResu = Sheets("Resultat")

  Ligne = 1

  For J = 2 To WsOrig.Range("A" & Rows.Count).End(xlUp).Row
    WsOrig.Range("A" & J & ":P" & J).Copy WsResu.Range("A" & Ligne)
    Ligne = Ligne + 1
    If Trim(WsOrig.Range("Q" & J)) <> "" Then
      WsOrig.Range("A" & J & ":C" & J).Copy WsResu.Range("A" & Ligne)
      WsResu.Range("D" & Ligne) = WsOrig.Range("Q" & J)
      WsResu.Range("F" & Ligne) = WsOrig.Range("D" & J)
      WsResu.Range("G" & Ligne) = WsOrig.Range("J" & J)
      WsResu.Range("H" & Ligne) = WsOrig.Range("D" & J)
      WsResu.Range("I" & Ligne) = WsOrig.Range("R" & J)
      Ligne = Ligne + 1
    End If
    If Trim(WsOrig.Range("S" & J)) <> "" Then
      WsOrig.Range("A" & J & ":C" & J).Copy WsResu.Range("A" & Ligne)
      WsResu.Range("D" & Ligne) = WsOrig.Range("S" & J)
      WsResu.Range("F" & Ligne) = WsOrig.Range("D" & J)
      WsResu.Range("G" & Ligne) = WsOrig.Range("J" & J)
      WsResu.Range("H" & Ligne) = WsOrig.Range("D" & J)
      WsResu.Range("I" & Ligne) = WsOrig.Range("T" & J)
      Ligne = Ligne + 1
    End If
  Next J
End Sub

wouau,

Je suis impressionné par la rapidité de la réponse et l'efficacité de la macro.

Merci pour le double compteur et la sortie de boucle en fin de fichier.

Ne me reste plus qu'à bien organiser mon fichier "Origine".

Bonne fin de dimanche.

Re,

Dans cette procédure je ne sais pas trouver l'équivalent de la concatenation de certaines cellules.

Ex:

=CONCATENER(Origine!C1;" ";Origine!D1)

pour les placer en

 Resultat!C1

Bonsoir

Tu veux modifier la page résultat pour avoir le Nom et prénom dans la même cellule ?

Prépares un fichier en notant manuellement dans chaque cellule de la page Résultat, le nom des cellules de la page Origine que tu veux avoir exactement

Voilà,

Je voudrais obtenir les concaténations suivantes.

Si tu me montre la 1°, je pense que j'arriverai à faire les 3 autres.

Resultat :

"A" | "B" | "C" & " " & "D" | "E" | "F" | "G" & " " & "H" | "I" | "J" & " " & "K" | "L" | "M" | "N" & " " & "O" | "P"

Bonsoir

A vérifier boucle_arret3

ça marche impec, sauf que je ne vois pas le code.

=> Rien à apprendre pour une prochaine fois.

Merci

Oups,

Trouvé.

Merci

Bonsoir,

Voici la macro complète commentée si qn est intéressé.

Sub Boucle_avec_Arret()
'
'
Dim WsOrig As Worksheet
Dim WsResu As Worksheet
Dim J As Long
Dim Ligne As Long

  Set WsOrig = Sheets("Origine")
  Set WsResu = Sheets("Resultats")

    '
    ' J pour les éléments WsOrig
    ' Ligne pour les éléments WsResu
    '

  Ligne = 1
    '
    '#########
    ' Couple '
    '#########
    '
    ' J : ligne à partir de laquelle commence le fichier "Origine"
    ' (permet de ne pas prendre en compte la ligne des titres)
    '
  For J = 1 To WsOrig.Range("A" & Rows.Count).End(xlUp).Row
    ' 1ère ligne
    ' A     : Acte = Mariage
    WsResu.Range("A" & Ligne) = "M"
    ' B     : Date Mariage
    WsOrig.Range("M" & J).Copy WsResu.Range("B" & Ligne)
    ' C     : Pasteur
    WsResu.Range("C" & Ligne) = ""
    ' D     : NOMPR
    WsResu.Range("D" & Ligne) = UCase(WsOrig.Range("F" & J)) & " " & WsOrig.Range("G" & J)
    ' E     : Date RH
    ' F     : Lieu RH
    WsOrig.Range("D" & J & ":E" & J).Copy WsResu.Range("E" & Ligne)
    ' G     : Lieu1
    ' H     : PEREMAR
    WsOrig.Range("I" & J & ":J" & J).Copy WsResu.Range("G" & Ligne)
    ' I     : MEREMAR
    WsResu.Range("I" & Ligne) = UCase(WsOrig.Range("K" & J)) & " " & WsOrig.Range("L" & J)
    ' J     : Observ1
    WsOrig.Range("H" & J).Copy WsResu.Range("J" & Ligne)
    ' K     : COTE
    WsOrig.Range("C" & J).Copy WsResu.Range("K" & Ligne)
    ' L     : MARIEE
    WsResu.Range("L" & Ligne) = UCase(WsOrig.Range("F" & J)) & " " & WsOrig.Range("G" & J)
    ' M     : Lieu2
    ' N     : PEREMARIEE
    WsOrig.Range("P" & J & ":Q" & J).Copy WsResu.Range("M" & Ligne)
    ' O     : MEREMARIEE
    WsResu.Range("O" & Ligne) = UCase(WsOrig.Range("R" & J)) & " " & WsOrig.Range("S" & J)
    ' P     : Observ2 (Fusion CMNOTDAT + NOTES1 + NOTES2)
    WsResu.Range("P" & Ligne) = WsOrig.Range("T" & J) & " " & WsOrig.Range("V" & J) & " " & WsOrig.Range("W" & J)
    '
    '###################
    ' Tous les Enfants '
    '     du couple    '
    '###################
    '
    Ligne = Ligne + 1
    '
    ' k : fait passer le curseur directement sur la cellule du 1° enfant ("X" = 24)
    ' Les données de l'enfant sont sur 3 colonnes
    ' Step 3 : prend en compte 1 cellule sur 3
    ' A modifier selon le nbr de colonnes
    '
    For k = 24 To 59 Step 3
     '
    ' Test vérifiant l'existence de données pour un enfant
    ' et sortie de boucle s'il n'y en a pas/plus
    '
    If Trim(WsOrig.Cells(J, k).Value) = "" Then
        Exit For
    '
    ' Sinon traitement des données de l'enfant
    '
    ElseIf Trim(WsOrig.Cells(J, k).Value) <> "" Then
    ' A     : Acte = Naissance
    WsResu.Range("A" & Ligne) = "N"
    ' B     : Date Naissance
    WsOrig.Cells(J, (k + 1)).Copy WsResu.Range("B" & Ligne)
    ' C     : Pasteur
    WsResu.Range("C" & Ligne) = ""
    ' D     : NOMPR
    WsResu.Range("D" & Ligne) = UCase(WsOrig.Range("F" & J)) & " " & WsOrig.Cells(J, k)
    ' E     : Date RH
    ' F     : Lieu RH
    WsOrig.Range("D" & J & ":E" & J).Copy WsResu.Range("E" & Ligne)
    ' G     : Lieu1
    ' H     : PERE
    WsOrig.Range("G" & J).Copy WsResu.Range("G" & Ligne)
    ' I     : MERE
    WsResu.Range("I" & Ligne) = UCase(WsOrig.Range("F" & J)) & " " & WsOrig.Range("G" & J)
    ' J     : Observ1
    WsOrig.Cells(J, (k + 2)).Copy WsResu.Range("J" & Ligne)
    ' K     : Cote
    WsOrig.Range("C" & J).Copy WsResu.Range("K" & Ligne)
      Ligne = Ligne + 1
          End If
    ' Prochain enfant
    Next k
    ' Saut de ligne entre chaque famille
    Ligne = Ligne + 1
  Next J
  WsResu.Columns("A:P").AutoFit
End Sub