Copier des cellules si une condition est verifiée Fermé

Question

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.ClearColumns("A:A").ColumnWidth = 25Worksheets("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 lastlignFor i = 2 To lastlignIf Worksheets("Détails").Range("C" & i) = "" Theni = i + 1ElseWorksheets("nombredetr").Range("A" & j) = Worksheets("Détails").Range("A" & i) & " " & Worksheets("Détails").Range("A" & i)End IfNext iNext jEnd Sub


Merci d'avace pour votre aide
Configuration: Windows 7 / Chrome 52.0.2743.116

ThauTheme · Answer

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

pijaku · Answer

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

hajars · Answer

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

thev · Answer

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 WithEnd Sub --

hajars · Answer

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

Copier des cellules si une condition est verifiée

5 réponses

Discussions similaires