Copier des cellules si une condition est verifiée
Fermé
hajars
Messages postés
32
Date d'inscription
mardi 26 juillet 2016
Statut
Membre
Dernière intervention
20 septembre 2016
-
16 août 2016 à 10:29
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016 - 16 août 2016 à 16:01
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016 - 16 août 2016 à 16:01
A voir également:
- Excel copier une cellule si condition
- Liste déroulante excel - Guide
- Formule excel - Guide
- Excel colorer une cellule sous condition d'une autre cellule ✓ - Forum Excel
- Excel cellule couleur si condition texte - Forum Excel
- Colorer cellule excel sous condition - Guide
5 réponses
ThauTheme
Messages postés
1442
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
29 juillet 2022
160
16 août 2016 à 12:36
16 août 2016 à 12:36
Bonjour Hajars, bonjour le forum,
Essaie comme ça :
Essaie comme ça :
Sub Presentation()
Dim D As Worksheet 'déclare la variable D (onglet Détails)
Dim N As Worksheet 'déclare la variable N (onglet nombredetr)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Set D = Worksheets("Détails") 'définit l'onglet D
Set N = Worksheets("nombredetr") 'définit l'onglet N
TV = D.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
N.Cells.Clear 'efface "tout" dans toutes les cellules de l'onglet N
N.Columns("A:A").ColumnWidth = 25 'définit la largeur de la colonne A de l 'onglet N
N.Range("A1").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1) 'renvoie les étiquettes du tableau des valeur TV dans la première ligne à partir de A1 de l'onglet N
'N.Range("A1").Value = "Nom et Prénom"'inutile si la ligne au dessus fonctionne...
'N.Range("B1").Value = "Code VAT System"...
'N.Range("C1").Value = "Code Salarié"...
'N.Range("D1").Value = "Code Rubrique"...
'N.Range("E1").Value = "Date de début"...
'N.Range("F1").Value = "Date de Fin"...
'N.Range("G1").Value = "Plage de début"...
'N.Range("H1").Value = "Plage de Fin"...
'mise en forme de la plage A1:H1 de l'onglet N
With N.Range("A1:H1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Worksheets("nombredetr").Range("A1:H1").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
' .HorizontalAlignment = xlCenter
' .Borders.Weight = xlThin
End With
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
If TV(I, 3) <> "" Then 'condition : si la donnée ligne I colonne 3 (=> colonnee C) deV est vide
ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la valeur de la colonne J de TV (= transposition)
Next J 'prochaijne colonne de la boucle 2
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à un, renvoie dans la cellule A2 redimensionnée de l'onglet N, le tableau TL transposé
If K > 1 Then N.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.tranpose(TL)
End Sub

