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é
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).