Copier des cellules si une condition est verifiée

hajars Messages postés 32 Date d'inscription Statut Membre Dernière intervention -
hajars Messages postés 32 Date d'inscription Statut Membre Dernière intervention - 16 août 2016 à 16:01

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

Afficher la suite

A voir également:

Copier cellule si condition
Excel cellule couleur si condition texte - Guide
Dessin sms copier coller zizi ✓ - Forum Réseaux sociaux
Excel si cellule contient partie texte ✓ - Forum Excel
Comment copier une vidéo youtube - Guide
Super copier - Télécharger - Gestion de fichiers

5 réponses

Réponse 1 / 5

ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention 160

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

Réponse 2 / 5

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

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

Réponse 3 / 5

thev Messages postés 1986 Date d'inscription Statut Membre Dernière intervention 713

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

Réponse 4 / 5

hajars Messages postés 32 Date d'inscription Statut Membre Dernière intervention

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

Utilisateur anonyme

Essaye avec : Dim TL As Variant

ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention 160 > Utilisateur anonyme

Re,

Oui en effet, j'avais oublié de déclarer la variable TL... Merci Albkan !

Réponse 5 / 5

hajars Messages postés 32 Date d'inscription Statut Membre Dernière intervention

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

Discussions similaires

colorer une cellule en fonction de la valeur d'une autre cellule

Colorier une cellule en fonction d'une autre

valeurs uniques avec critère

Excel : si ma cellule contient tel texte ou tel texte

Recherche V selon 2 critères

Remplir une cellule (texte) en fonction d'une autre (texte).

Votre réponse

Discussions similaires