Création boucle pour instruction

Bonjour à tous,

Pour l'automatisation d'un rapport, j'ai créé une instruction qui me copier certaines cellules sur la même ligne de ma feuille réunion hebdo, vers ma feuille rapport réunion, copie nom plus sur ligne mais en colonne.

Ma procédure ne marche que pour la première ligne, je voudrais qu’elle fasse pareil sur les ligne désigner au départ part un msg box, " msg à partir de quelle ligne..., jusque-là ligne ..." et ma procédure se lancerais pour toute les lignes entre les numéros désignés. ( ex de la ligne 2 à 7 définit a chaque fois)

J'ai essayé beaucoup de chose mais je ne trouve pas et pas encore pu apprendre les boucles

deuxième souci, pour cette partie

Cells(i, 1).Copy
  Worksheets("Rapport_Réunion_QES").Range("A" & Der_Lin_Vid + 2).PasteSpecial Paste:=xlPasteValues

Ici je copie A2 vers la ligne désignée, mais je voudrais que A2 G2 et H2 soit copier dans la même cellule ==> A2 / G2 / H2 en gras vers

Range("A" & Der_Lin_Vid + 2)
Cells(i, 3).Copy
  Worksheets("Rapport_Réunion_QES").Range("A" & Der_Lin_Vid + 3).PasteSpecial Paste:=xlPasteValues

ici le résultat est bon mais je n'arrive pas à mettre en gras italiques souligné

3rapport-auto.xlsm (23.45 Ko)

Voici mon instruction complète

Sub Rapport_QES_Auto()

Dim i As Integer
Dim Der_Lin_Vid  As Long
            i = 2
    Der_Lin_Vid = Worksheets("Rapport_Réunion_QES").Range("A" & Cells.Rows.Count).End(xlUp).Row ' Dernière ligne vide dans la feuille Rapport_Réunion_QES

Application.ScreenUpdating = False
  If MsgBox("Voulez-vous créer un rapport de réunion ?", vbYesNo + vbDefaultButton2 + vbQuestion, "Important") = vbYes Then

  ' Copier les données de la feuille "Réunion_Hebdo" dans la première ligne vide de la feuille Rapport_Réunion_QES
  Cells(i, 1).Copy
  Worksheets("Rapport_Réunion_QES").Range("A" & Der_Lin_Vid + 2).PasteSpecial Paste:=xlPasteValues
  Cells(i, 3).Copy
  Worksheets("Rapport_Réunion_QES").Range("A" & Der_Lin_Vid + 3).PasteSpecial Paste:=xlPasteValues
  Cells(i, 4).Copy
  Worksheets("Rapport_Réunion_QES").Range("A" & Der_Lin_Vid + 4).PasteSpecial Paste:=xlPasteValues
  Application.CutCopyMode = False
  Else
  Exit Sub
  End If
Application.ScreenUpdating = True
End Sub

Bonjour,

Je n'ai pas très bien compris (et n'ai pas regardé le fichier) mais voici un essai qui semble cohérent :

for i = 1 to fin '<<<< fin A DEFINIR !!!!
    for k = 1 to 3
        col = choose(k, 1, 7, 8) 'permet de répéter l'opération pour les colonnes 1, 7 et 8 (A, G et H)
        Worksheets("Rapport_Réunion_QES").cells(Der_Lin_Vid + 2, col).value = sheets("A PRECISER!!!").Cells(i, col).value '<<< NOM FEUILLE !!!
    next k
    Der_Lin_Vid = Der_Lin_Vid + 1 '<<< DOUTE : incrémentation dernière ligne vide
next i

J'ai un doute sur le

Der_Lin_Vid  + 2

MAis en adaptant, vous devriez obtenir le résultat attendu.

Cdlt,

3GB, merci je vais y regarder

Je dois avouer que je n'y comprend pas grand chose, j'ai ajouté mon code complet dans mon premier post

Bonjour,

Je n'ai pas très bien compris (et n'ai pas regardé le fichier) mais voici un essai qui semble cohérent :

for i = 1 to fin '<<<< fin A DEFINIR !!!!

for k = 1 to 3

col = choose(k, 1, 7, 8) 'permet de répéter l'opération pour les colonnes 1, 7 et 8 (A, G et H)

Worksheets("Rapport_Réunion_QES").cells(Der_Lin_Vid + 2, col).value = sheets("A PRECISER!!!").Cells(i, col).value '<<< NOM FEUILLE !!!

next k

Der_Lin_Vid = Der_Lin_Vid + 1 '<<< DOUTE : incrémentation dernière ligne vide

next i

J'ai un doute sur le

Der_Lin_Vid + 2

MAis en adaptant, vous devriez obtenir le résultat attendu.

Re,

Moi non plus, je n'y comprends plus grand-chose .

Est-ce qu'il faut transposer les données ? Est-ce qu'il faut boucler ou cette opération ne concerne que la ligne 2 (et la première ligne non vide) ?

Voici une adaptation de ton code si je l'ai bien compris :

Sub Rapport_QES_Auto()
If MsgBox("Voulez-vous créer un rapport de réunion ?", vbYesNo + vbDefaultButton2 + vbQuestion, "Important") <> vbYes Then exit sub
Application.ScreenUpdating = False
with Worksheets("Rapport_Réunion_QES") 'avec feuille destination
    dl = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne vide en colonne 1
    for k = 1 to 3 'opération répétée 3 fois
        col = choose(k, 1, 3, 4) 'définition de la colonne source en fonction de la valeur de k
        'en colonne 1, la derniere cellule + k prend valeur de la cellule en colonne col de la ligne 2
        .cells(dl + k, 1).value = sheets("SOURCE").Cells(2, col).value '<<< NOM FEUILLE A PRECISER!!!
    next k
end with
Application.ScreenUpdating = True
End Sub

On pourra essayer après la concaténation...

Cdlt,

Re,

Ton code me donne le même résultat que le mien sur ma feuille de destination, en bien plus optimisé

Sub Rapport_QES_Auto()
If MsgBox("Voulez-vous créer un rapport de réunion ?", vbYesNo + vbDefaultButton2 + vbQuestion, "Important") <> vbYes Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Rapport_Réunion_QES") 'avec feuille destination
    dl = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne vide en colonne 1
    For k = 1 To 3 'opération répétée 3 fois
        col = Choose(k, 1, 3, 4) 'définition de la colonne source en fonction de la valeur de k
        'en colonne 1, la derniere cellule + k prend valeur de la cellule en colonne col de la ligne 2
        .Cells(dl + 1 + k, 1).Value = Sheets("Réunion_Hebdo").Cells(2, col).Value '<<< NOM FEUILLE A PRECISER!!!
    Next k
End With
Application.ScreenUpdating = True
End Sub

mais comment le faire tourner en boucle de la ligne 2 à 10 de ma feuille source (réunion hebdo)

et comment avoir en gras les résultats qui correspond à 1 et 3 dans

col = Choose(k, 1, 3, 4)

Oui c'était mon idée de départ mais vu qu'il y a transposition, où met-on les valeurs ensuite ?

Je vais considérer qu'on les mets à la suite :

Sub Rapport_QES_Auto()
If MsgBox("Voulez-vous créer un rapport de réunion ?", vbYesNo + vbDefaultButton2 + vbQuestion, "Important") <> vbYes Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Rapport_Réunion_QES") 'avec feuille destination
    for i = 2 to 10
        nvl = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'premiere ligne vide en colonne 1
        For k = 1 To 3
            col = Choose(k, 1, 3, 4)
            with .Cells(nvl + k, 1)
                .Value = Sheets("Réunion_Hebdo").Cells(i, col).Value
                if k < 3 then .font.bold = true
            end with
        Next k
    next i
End With
Application.ScreenUpdating = True
End Sub

Cdlt,

with .Cells(nvl + k, 1)
                .Value = Sheets("Réunion_Hebdo").Cells(i, col).Value
                if k < 3 then .font.bold = true
            end with

ça marche bien, peux tu m'en dire un peux plus sur cette partie que je ne comprend pas

Oui :

with .Cells(nvl + k, 1)

permet de cibler l'objet à manipuler, en l'occurence la cellule à la ligne nvl + k et à la colonne 1. C'est une factorisation du code (ça évite de réécrire à chaque fois .cells).

Donc ce qu'on a fait ici :

with .Cells(nvl + k, 1) 'avec la cellule de destination (nouvelle ligne + k)
    .Value = Sheets("Réunion_Hebdo").Cells(i, col).Value sa valeur prend la valeur de la cellule en ligne i et colonne col de la source
    if k < 3 then .font.bold = true 'si k < 3, on met la cellule en gras (font est la police et bold le gras)
end with

C'est pas évident à expliquer car il faut contextualiser ces lignes qui sont au coeur d'une boucle sur k (à la fois incrémentateur des lignes de la destination, et index des colonnes de la source), elle-même dans une autre boucle sur i (incrémentateur des lignes de la source et qui permet à chaque fois de déterminer nvl (et donc de marquer la séparation entre les blocs).

Si tu as des questions, n'hésite pas.

3GB, un tout grand merci pour ton aide,

j'ai modifié quelque peu en y ajoutant des variables pour la boucle "I" et quelque mise en forme de plus

Sub Rapport_QES_Auto()
Dim var1 As String
Dim var2 As String
If MsgBox("Voulez-vous créer un rapport de réunion ?", vbYesNo + vbDefaultButton2 + vbQuestion, "Important") <> vbYes Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Rapport_Réunion_QES") 'avec feuille destination
    Do
    var1 = InputBox("A quelle ligne commence le rapport ?", "Numéro de ligne")
    If var1 = "" Then Exit Sub
    Loop While var1 = ""
    Do
    var2 = InputBox("A quelle ligne termine le rapport ?", "Numéro de ligne")
    If var2 = "" Then Exit Sub
    Loop While var2 = ""
    For i = var1 To var2
        nvl = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'premiere ligne vide en colonne 1
        For K = 1 To 3
            col = Choose(K, 1, 3, 4)
            With .Cells(nvl + K, 1)
                .Value = Sheets("Réunion_Hebdo").Cells(i, col).Value
                If K < 3 Then .Font.Italic = True
                If K < 3 Then .Font.Bold = True
                If K = 2 Then .Font.Underline = True
            End With
        Next K
    Next i
End With
Application.ScreenUpdating = True
End Sub

il reste une chose ou je bloque, pour cette partie de code,

col = Choose(K, 1, 3, 4)

Si j'ai bien tout comprit,

pour le 1 (qui est la 1er colonne) et pour faire simple on copie la cellule A2 de la feuille1( Réunion hebdo) vers la dernière ligne vide +1 de la colonne "A" sur feuille2 (Rapport réunion)

Ce qu'il me faudrait ce que le "1" donne comme résultat la concaténation de A2,G2,H2 au format A2 / G2 / H2

Ce que j'ai essayé c'est de déclarer une variante pour remplacer le 1 mais sans résultat

Salut xXJohnXx,

Voici un essai pour ce problème :

Sub Rapport_QES_Auto()
Dim var1 As String
Dim var2 As String
If MsgBox("Voulez-vous créer un rapport de réunion ?", vbYesNo + vbDefaultButton2 + vbQuestion, "Important") <> vbYes Then Exit Sub
Application.ScreenUpdating = False
set wss = Sheets("Réunion_Hebdo") '<<<< feuille source
With Worksheets("Rapport_Réunion_QES") 'avec feuille destination
    Do
    var1 = InputBox("A quelle ligne commence le rapport ?", "Numéro de ligne")
    If var1 = "" Then Exit Sub
    Loop While var1 = ""
    Do
    var2 = InputBox("A quelle ligne termine le rapport ?", "Numéro de ligne")
    If var2 = "" Then Exit Sub
    Loop While var2 = ""
    For i = var1 To var2
        nvl = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'premiere ligne vide en colonne 1
        For K = 1 To 3
            col = Choose(K, 1, 3, 4)
            ajout = iif(k = 1, " / " & wss.Cells(i, 7).Value & " / " & wss.Cells(i, 8).Value, "") '<<<<<
            With .Cells(nvl + K, 1)
                .Value = wss.Cells(i, col).Value & ajout '<<<<<
                If K < 3 Then .Font.Italic = True: .Font.Bold = True
                If K = 2 Then .Font.Underline = True
            End With
        Next K
    Next i
End With
Application.ScreenUpdating = True
End Sub

Tout d'abord, j'utilise une variable wss (worksheet source) pour éviter d'avoir des lignes qui trainent en longueur...

Si k = 1, " / G / H" est stocké dans la variable ajout, celle-ci étant ensuite ajoutée à la fin de la valeur. Pour le besoin, ça me semble correct mais il y aurait moyen d'améliorer je pense.

En tout cas, ça ma parait très bien sinon.

Je me dis juste qu'à ta place, je réfléchirais peut-être à une alternative pour remplacer les inputbox. C'est toujours délicat car cela nécessite l'intervention de l'utilisateur et augmente donc le risque de bugs. L'idéal serait de rendre toute la procédure automatique en recherchant par exemple un mot qui permette de déterminer les lignes de début et de fin. Si ce n'est pas possible, c'est pas grave mais si ça l'était, ce serait une amélioration à mon avis.

Cdlt,

3GB,

un tout grands merci pour ton aide et tes explication, le résultat et vraiment impeccable et j'ai appris beaucoup de chose en plus,

Pour ton conseil, dans les données que je reporte, il n'y a rien qui commence par le même mot, c'est pour cela que que j'ai plutôt mis par numéro de ligne

et en variable car jamais les même

Encore un grand merci.

Je t'en prie ! Je suis content que tu sois arrivé au résultat attendu !

Tant pis pour les inputbox... Si ce code devait être utilisé par d'autres que toi, fais quand même des petits essais avec des saisies de valeurs négatives, de décimaux, de chaines de caractères, dates, ... Et essaie de rajouter une gestion d'erreurs car une mauvaise saisie (malencontreuse ou pas^^) n'est pas à exclure.

Bonne continuation et à bientôt sur le forum !

Peu être encore une petite chose, il serais possible d'ajouter une condition,

si la colonne 9 a une valeur "O" on copie les données si "N" on copie pas

Oui, il faut mettre la condition au tout début de la première boucle (si j'ai bien compris) :

    For i = var1 To var2
        if wss.cells(i, 9).value = "O" then
            nvl = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'premiere ligne vide en colonne 1
            For K = 1 To 3
                col = Choose(K, 1, 3, 4)
                ajout = iif(k = 1, " / " & wss.Cells(i, 7).Value & " / " & wss.Cells(i, 8).Value, "") '<<<<<
                With .Cells(nvl + K, 1)
                    .Value = wss.Cells(i, col).Value & ajout '<<<<<
                    If K < 3 Then .Font.Italic = True: .Font.Bold = True
                    If K = 2 Then .Font.Underline = True
                End With
            Next K
        end if
    Next i

Ici, on ne copie que lorsqu'il y a "O" en colonne I de la feuille source. Sinon, par défaut on ne copie pas (que le cellule contienne "N", "", ou autre chose).

super!

Rechercher des sujets similaires à "creation boucle instruction"