Copier des cellules si une condition est verifiée

Fermé
Signaler
Messages postés
32
Date d'inscription
mardi 26 juillet 2016
Statut
Membre
Dernière intervention
20 septembre 2016
-
Messages postés
32
Date d'inscription
mardi 26 juillet 2016
Statut
Membre
Dernière intervention
20 septembre 2016
-
Bonjour,

Je dois créer un fichier csv qui contient certains informations que je dois importer de differentes feuilles Pour cela j'ai pensé a creer un tableau excel d'abord et apres le transformer en csv

En effet, Mon tableau que j ai créé sur la feuille"nombredetr"doit contenir en 1ere colonne le Nom et Prénom que je veux copier de la feuille "détails" si la colonne C qui est le matricule est renseignée.
En gros Si la colonne C de la feuille "details" n est pas vide Copier le nom et prénom dans lafeuille "nombredetr" Sinon passer a la ligne suivante
J ai fait ce code, ça me donne aucun résultat et aucun erreur . Je pense j'ai un problème avec l'algo que j ai fait

Sub Presentation()
Worksheets("nombredetr").Cells.Clear

Columns("A:A").ColumnWidth = 25

Worksheets("nombredetr").Range("A1").Value = "Nom et Prénom"
Worksheets("nombredetr").Range("B1").Value = "Code VAT System"
Worksheets("nombredetr").Range("C1").Value = "Code Salarié"
Worksheets("nombredetr").Range("D1").Value = "Code Rubrique"
Worksheets("nombredetr").Range("E1").Value = "Date de début"
Worksheets("nombredetr").Range("F1").Value = "Date de Fin"
Worksheets("nombredetr").Range("G1").Value = "Plage de début"
Worksheets("nombredetr").Range("H1").Value = "Plage de Fin"

With Worksheets("nombredetr").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

For j = 2 To lastlign
For i = 2 To lastlign
If Worksheets("Détails").Range("C" & i) = "" Then
i = i + 1
Else
Worksheets("nombredetr").Range("A" & j) = Worksheets("Détails").Range("A" & i) & " " & Worksheets("Détails").Range("A" & i)

End If
Next i
Next j



End Sub



Merci d'avace pour votre aide

5 réponses

Messages postés
1419
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
16 janvier 2022
156
Bonjour Hajars, bonjour le forum,

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

1
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 677
Bonjour,

Je pense j'ai un problème avec l'algo que j ai fait
Je confirme.
Remplacez :
For j = 2 To lastlign
   For i = 2 To lastlign
      If Worksheets("Détails").Range("C" & i) = "" Then
         i = i + 1
      Else
         Worksheets("nombredetr").Range("A" & j) = Worksheets("Détails").Range("A" & i) & " " & Worksheets("Détails").Range("A" & i)

      End If
   Next i
Next j 

par :
j = 2
For i = 2 To lastlign
   If Worksheets("Détails").Range("C" & i) <> "" Then
      Worksheets("nombredetr").Range("A" & j) = Worksheets("Détails").Range("A" & i) & " " & Worksheets("Détails").Range("B" & i)
      j = j + 1
   End If
Next i


Ou encore mieux par :
Application.ScreenUpdating = False
j = 2
With Worksheets("Détails")
   For i = 2 To lastlign
      If .Range("C" & i) <> "" Then
         Worksheets("nombredetr").Range("A" & j) = .Range("A" & i) & " " & .Range("B" & i)
         j = j + 1
      End If
   Next i
End With
Application.ScreenUpdating = True

1
Messages postés
1770
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
11 novembre 2021
662
Bonjour,

Ce code devrait fonctionner

Sub Presentation()

With Worksheets("nombredetr")
.Cells.Clear

.Columns("A:A").ColumnWidth = 25

.Range("A1").Value = "Nom et Prénom"
.Range("B1").Value = "Code VAT System"
.Range("C1").Value = "Code Salarié"
.Range("D1").Value = "Code Rubrique"
.Range("E1").Value = "Date de début"
.Range("F1").Value = "Date de Fin"
.Range("G1").Value = "Plage de début"
.Range("H1").Value = "Plage de Fin"

Set nombredetr_A2 = .Range("A2") 'première cellule à remplir
End With

With Worksheets("nombredetr").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



With Worksheets("Détails").UsedRange 'plage utilisée
j = 0
For i = 2 To .Rows.Count
If .Range("C" & i) <> "" Then
nombredetr_A2.Offset(j) = .Range("A" & i) & " " & .Range("B" & i)
j = j + 1
End If
Next i
End With



End Sub


--
 
1
Messages postés
32
Date d'inscription
mardi 26 juillet 2016
Statut
Membre
Dernière intervention
20 septembre 2016

je viens de tester.
ca me donne TL variable non définie du coup je l'ai defini As Range et ils me soulignent la ligne 48 message d erreur -> tableau attendu.
Mercii
0
Essaye avec : Dim TL As Variant
0
Messages postés
1419
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
16 janvier 2022
156 > Utilisateur anonyme
Re,

Oui en effet, j'avais oublié de déclarer la variable TL... Merci Albkan !
0
Messages postés
32
Date d'inscription
mardi 26 juillet 2016
Statut
Membre
Dernière intervention
20 septembre 2016

Merci beaucoup a vous tous
Tous ces codes marchent super bien mais maintenant j'ai un problème beaucoup plus délicat et compliqué.
En fait, je dois créer une ligne pour chaque congé pris par un salarié cad si un salarié a pris deux conges en un mois je dois avoir sur mon tableau 2 fois son nom avec les informations qui vont avec qui seront son nom et prenom, le code de l entreprise, son matricule le code du congé la date de debut la date de fin plage de debut(journee matin aprem) plage de fin
le probleme c est que la feuille ou il y a chaque salarié et ses congés est sous forme de tableaux avec des codes couleurs (capture1)
et la feuille ou il y a les codes rubriques c est une autre feuille.
Je vois pas comment je pourrai faire pour dire en vba Pour chaque congé ajouter une ligne d'un salarié ni comment recuperer les dates et les codes parce que c'est pas un tableau normal.

Ci-joint les feuilles qui me posent problemes
capture1 c est la feuille planning_conges.xls ou il y a le nom des salariés les congés qu ils ont eu le type du congé la date la plage
Chaque cellule est soit disant composé en deux (matin, apresmidi)

Capture2 c est la feuille rubrique où il y a le code rubrique des code congés et le libellé

SI vous avez des idées ou des astuces dites moi s'il vous plait

Merci beaucoup
0